C

C******************  SUBMISSION  LEW-11629  ******************************M--

C

$IBFTC GASPY

C                                                                              1

C     ------------------NASA  LEWIS  RESEARCH---------------------------       2

C     ---------------------------VERSION 2/1/72-------------------------       3

C     -----------FOR  INFORMATION --SEE  A.BARON, R.C.HENDRICKS,I.PELLER       4

C                                                                              5

      SUBROUTINE GASP%KS,KP,T,P,D,H,KR<                                        6

C      BENDER-S EQUATION OF STATE FOR THE FIVE GASES--N2,CH4,AR,O2,CO2         7

C       ALSO EQUATIONS OF STATE FOR CO, NE, AND HELIUM...                      8

C -------------------------- PRYDZ EQUATION FOR FLUORINE ---------------       9

C                                                                             10

C        COMPUTE THE STATE RELATIONS AND THERMODYNAMIC AND                    11

C        TRANSPORT PROPERITES OF SPECIFIED FLUID GIVEN TEMPERATURE T,         12

C        PRESSURE P, DENSITY D, OR ENTHALPY H.  STATE RELATIONS ARE           13

C        SPECIFIED BY KS.  THERMODYNAMIC AND TRANSPORT PROPERTIES             14

C        ARE SPECIFIED BY KP.  IF KR IS RETURNED OR SPECIFIED AS 1,           15

C        PROPERTIES ARE COMPUTED AT SATURATION.                               16

C                                                                             17

      DIMENSION KPC1%32<, KPC2%32<, KPC3%32<,KPC4%32<                         18

      COMMON/PROPTY/KU,DL,DV,HL,HV,S,SL,SV,CV,CVL,CVV,CP,CPL,CPV,GAMMA,       19

     1GAMMAL,GAMMAV,C,CL,CVP,MU,MUL,MUV,K,KL,KV,SIGMA,EXCL,EXCV,EXCESK        20

      REAL MU,MUL,MUV,K,KL,KV                                                 21

      COMMON/DERIV/PDT,PTV,PDTL,PDTV,PTVL,PTVV                                22

      COMMON/PARTLS/PTV1,PDT1                                                 23

      COMMON/CHECKS/DCH1   ,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,H      24

     1SCH1,HSCH2                                                              25

      COMMON/HELFLU/ IHE,IFY,IHY                                              26

      DATA KPC1 /2,3,6,7,10,11,14,15,18,19,22,23,26,27,30,31,34,35,38,        27

     139,42,43,46,47,50,51,54,55,58,59,62,63/                                 28

      DATA KPC2 /4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31,36,37,38,        29

     139,44,45,46,47,52,53,54,55,60,61,62,63/                                 30

      DATA KPC3 /8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31,40,41,42,      31

     143,44,45,46,55,56,57,58,59,60,61,62,63/                                 32

      DATA KPC4 /16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,             33

     148,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63/                        34

      GO TO %10,20,30,40,45<,KS                                               35

C                                                                             36

C        COMPUTE DENSITY                                                      37

C                                                                             38

   10 CALL DENS%KU,T,P,D,DL,DV,KR<                                            39

      GO TO 50                                                                40

C                                                                             41

C        COMPUTE PRESSURE                                                     42

C                                                                             43

   20 CALL PRESS%KU,T,D,P,KR<                                                 44

      GO TO 50                                                                45

C                                                                             46

C        COMPUTE TEMPERATURE                                                  47

C                                                                             48

   30 CALL TEMP%KU,P,D,T,KR<                                                  49

      GO TO 50                                                                50

C                                                                             51

C        COMPUTE TEMPERATURE AND DENSITY GIVEN PRESSURE AND ENTHALPY          52

C                                                                             53

   40 CALL TEMPPH%KU,P,H,T,D,DL,DV,KR<                                        54

      GO TO 50                                                                55

C                                                                             56

C        COMPUTE  TEMPERATURE  AND  DENSITY  GIVEN  PRESSURE  AND  ENTRO      57

C                                                                             58

   45 CALL TEMPPS % KU,P,S,T,D,DL,DV,KR <                                     59

   50 IF %MOD%KP,2<< 60,70,60                                                 60

C                                                                             61

C        COMPUTE ENTHALPY                                                     62

C                                                                             63

   60 CALL ENTH%KU,KR,T,P,D,H,HL,HV<                                          64

   70 DO 80 I#1,32                                                            65

      IF %KP-KPC1%I<<110,100,80                                               66

   80 CONTINUE                                                                67

      GO TO 110                                                               68

C                                                                             69

C        COMPUTE ENTROPY                                                      70

C                                                                             71

  100 CALL ENT%KU,KR,T,P,D,S,SL,SV<                                           72

  110 DO 120 I#1,32                                                           73

      IF%KP-KPC2%I<< 140,130,120                                              74

  120 CONTINUE                                                                75

      GO TO 140                                                               76

  130 KCP#0                                                                   77

C                                                                             78

C        COMPUTE  SPECIFIC  HEATS  AND  SONIC  VELOCITY                       79

C                                                                             80

      IF %KR.NE.1< GO TO 200                                                  81

      CALL DENS%KU,T,P,D,DL,DV,1<                                             82

      CALL CPPRL%P,DL,T,CPL,CVL,KU,KR,KCP<                                    83

      PTVL#PTV1                                                               84

      PDTL#PDT1                                                               85

      GAMMAL#CPL/CVL                                                          86

      CALL SONIC%KU,KR,T,DL,GAMMAL,CL<                                        87

      CALL CPPRL%P,DV,T,CPV,CVV,KU,KR,KCP<                                    88

      PDTV#PDT1                                                               89

      PTVV#PTV1                                                               90

      GAMMAV#CPV/CVV                                                          91

      CALL SONIC%KU,KR,T,DV,GAMMAV,CVP<                                       92

      GO TO 140                                                               93

  200 CALL CPPRL%P,D,T,CP,CV,KU,KR,KCP<                                       94

      PDT#PDT1                                                                95

      PTV#PTV1                                                                96

      GAMMA#CP/CV                                                             97

      CALL SONIC%KU,KR,T,D,GAMMA,C<                                           98

  140 DO 150 I#1,32                                                           99

      IF %KP-KPC3%I<< 170,160,150                                            100

  150 CONTINUE                                                               101

      GO TO 170                                                              102

C                                                                            103

C        COMPUTE VISCOSITY                                                   104

C                                                                            105

  160 IF %KR.NE.1< GO TO 165                                                 106

      CALL DENS%KU,T,P,D,DL,DV,1<                                            107

      CALL VISC%KU,KR,T,DL,MUL<                                              108

      CALL VISC%KU,KR,T,DV,MUV<                                              109

      GO TO 170                                                              110

  165 CALL VISC%KU,KR,T,D,MU<                                                111

  170 DO 175 I#1,32                                                          112

      IF%KP-KPC4%I<< 190,180,175                                             113

  175 CONTINUE                                                               114

      GO TO 190                                                              115

C                                                                            116

C        COMPUTE THERMAL CONDUCTIVITY                                        117

C        NOTE-- FROZEN  VALUE  AVAILABLE  IN K,KL,KY                         118

C           --  REACTING  CONDUCTIVITY  RETURNED  IN  EXCESK, EXCL,EXCV      119

C                                                                            120

  180 IF %KR.NE.1< GO TO 220                                                 121

      CALL DENS%KU,T,P,D,DL,DV,1<                                            122

      CALL THERM %KU,KR,P,T,DL,EXCL,KL<                                      123

      CALL THERM %KU,KR,P,T,DV,EXCV,KV<                                      124

       GO TO 190                                                             125

  220 CALL THERM %KU,KR,P,T,D,EXCESK,K<                                      126

  190 IF%KP-32< 230,240,240                                                  127

C                                                                            128

C          COMPUTE SURFACE TENSION                                           129

C                                                                            130

  240 CALL SURF %KU,KR,T,SIGMA<                                              131

  230 RETURN                                                                 132

      END                                                                    133

$IBFTC BLOCD

C                                                                              1

C     ---------------------------VERSION 2/1/72-------------------------       2

C                                                                              3

C   STORES THE COEFFICIENTS FOR ALL FLUIDS FOR THE EQUATION OF STATE           4

C    AND THE TRANSPORT EQUATIONS.                                              5

C        STORES  CONVERSION  CONSTANTS  NEEDED  BY  ALL  FLUIDS                6

C                                                                              7

C                                                                              8

      BLOCK DATA                                                               9

      COMMON/GASES/MATCH%10<,MESSAG%15,10<                                    10

      COMMON/ CON123/ DCONV%5<,TCONV%5<,PCONV%5<                              11

      COMMON/CONV4/SCONV%5<                                                   12

      COMMON/CONV5/CCONV%5<                                                   13

      COMMON/CONV6/HCONV%5<                                                   14

      COMMON/ALLCOF/COF%57,10<,TCCOF%15,10<,AKSTCO%18,4<,DIST%10<,            15

     1WTMOL%10<,EPSOK%10<,ZETA%10<,FF%10<,SWT%10<,KSWT%10<,DIFTT%10<,         16

     2RHOSWT%10<,DTRIPL%10<                                                   17

      DIMENSION MCH4%15<,MN2%15<,MO2%15<,MAR%15<,MCO2%15<,MNE%15<,MCO%15      18

     1<,MHE%15<,MF2%15<,MH2%15<                                               19

      EQUIVALENCE%MESSAG%1,1<,MCH4%1<<,%MESSAG%1,2<,MN2%1<<,%MESSAG%1,3<      20

     1,MO2%1<<,%MESSAG%1,4<,MAR%1<<,%MESSAG%1,5<,MCO2%1<<,%MESSAG%1,6<,       21

     2MNE%1<<,%MESSAG%1,7<,MCO%1<<,%MESSAG%1,8<,MHE%1<<,%MESSAG%1,9<,MF2      22

     3%1<<,%MESSAG%1,10<,MH2 %1<<                                             23

      DATA %MATCH%I<,I#1,8</3HCH4,2HN2,2HO2 ,2HAR,3HCO2,2HNE,2HCO,2HHE/       24

        DATA MATCH%9</2HF2/                                                   25

      DATA MATCH%10</2HH2/                                                    26

      DATA MCH4%1<    /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR ME      27

     1THANE PC#45.66 ATM,TC#190.77 K,ROC#.162 G/CC /                          28

      DATA MN2%1<      /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR N      29

     1ITROGEN PC#33.72ATM,TC#126.3 K,ROC#.3105G/CC  /                         30

      DATA MO2%1<     /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR OX      31

     1YGEN PC#50.16ATM,TC#154.78 K,ROC#.4325G/CC   /                          32

      DATA MAR%1<     /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR AR      33

     1GON PC# 48.014ATM, TC#150.7 K,ROC#.531 G/CC  /                          34

      DATA MCO2%1<    /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR CO      35

     1 2 PC#72.869ATM, TC#304.21 K, ROC#.464 G/CC  /                          36

      DATA MNE%1<     /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR NE      37

     1ON PC# 26.19ATM ,TC#44.4 K, RHOC#.483 G/CC   /                          38

      DATA MCO%1<     /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR CO      39

     1  PC#34.529ATM, TC#132.91 K, RHOC#.2997 G/CC /                          40

      DATA MHE%1<     /90H THERMODYNAMIC AND TRANSPORT PROPERTIES FOR HE      41

     1 PC # 2ATM, TC#5 K, RHOC#1/25G/CC                   /                   42

      DATA MF2%1<     /90HTHERMODYNAMIC AND TRANSPORT PROPERTIES FOR FLU      43

     1ORINE PC#54ATM,TC#144.31K,RHOC#.3974G/CC               /                44

      DATA MH2%1</   90HTHERMODYNAMIC & TRANSPORT PROPERTIES FOR HYDROGE      45

     1N PC#12.759ATM,TC#32.976K,RHOC#.03143G/CC      /                        46

      DATA TCONV           /1.,1.,1.8,2*1./                                   47

      DATA PCONV/1.,9.8692327,145.03774 ,2*1./                                48

      DATA DCONV/2*1.,62.42796,2*1./                                          49

      DATA SCONV/2*1.,0.23900574,2*1./                                        50

      DATA CCONV/2*1.,0.0328084,2*1./                                         51

      DATA HCONV/2*1.,0.4302103,2*1./                                         52

C        METHANE-------------------BENDER 1971                                53

      DATA %COF%I,1<,I#1,57</       .518251          , .17191020E1     ,      54

     1-.86366402E3   , .25005236E5  ,-.12533848E8    , .34169547E9     ,      55

     2 .75523689     ,-.12111233E3  , .20547188E6    , .32337540E2     ,      56

     3-.61948317E4   ,-.25603803E2  , .11556713E4    , .27425297E5     ,      57

     4 .49499630E8   ,-.11956135E11 , .88302981E12   ,-.31713486E10    ,      58

     5 .12302028E13  ,-.64499295E14 , .37E2  ,8*0.  , -.32097996E2     ,      59

     6 .29976933E3, .70773219      , -.72349122E-2    , .40851153E-4   ,      60

     7-.12130439E-6, .148489295E-9   , .11167E3      ,7.96986252       ,      61

     8 .39225023E-2  ,-.56781803E-4  , .23442607E-6  ,-.22395007E-9    ,      62

     98.35517346     , .803207E3     , .260815       , .1E-4           ,      63

     1 .57           , .01167        ,4.627          , .5067E2         ,      64

     2 .9066E2       , .19077E3      , .6E3          , .45             ,      65

     3 .25E3         , .0            , .2E4          /                        66

C        NITROGEN------------------BENDER 1971                                67

      DATA %COF%I,2<,I#1,57</       .296797          , .48058175       ,      68

     1-.15047010E3   , .26071365E4  ,-.12792742E7    , .29436228E8     ,      69

     2 .37500265     ,-.50738465E2  , .14499236E5    , .1440998E1      ,      70

     3-.24136776E3   , .28954771    ,-.27613799E2    , .36048264E3     ,      71

     4-.20083357E7   , .43265184E9  ,-.16513521E11   ,-.10141439E8     ,      72

     5 .47216396E10  ,-.12016418E12 , .1E2 , 8*0. ,   -.66869126E1     ,      73

     6-.20086668E3 , .37077481       ,-.62602129E-2  , .56187159E-4   ,       74

     7-.25984366E-6 , .49025967E-9  , .77364   E2 ,  .29090035E&2      ,      75

     8 .89930170E-3, -.92394038E-5, .26008592E-7, -.14102926E-10,             76

     9 .23351167 E1  , .231188578E3 , .35693888E-1  , .1449    E-3  ,         77

     11.1208         ,  .010132     ,3.417          , .5067    E2   ,         78

     2 .64      E2   , .1263    E3  , .100     E4   , .92           ,         79

     3 .18      E3   , .0           , .8       E3  /                          80

C        OXYGEN--------------------BENDER 1970                                81

      DATA%COF%I,3<,I#1,57< /          .259832       , .34811077       ,      82

     1-.14070678E3   , .25061744E4   ,-.10081345E7   , .19074164E8     ,      83

     2-.40134966E-2  , .65172112E2   , .10962206E5   , .6972158        ,      84

     3-.26242449E3   , .191378       , .29416771 E2  , .78932076E2     ,      85

     4-.1923158E7    , .4610824E9    ,-.39936263E11  ,-.5668995E7      ,      86

     5 .13644286E10  , .91977198E11  ,5.4 , 8*0.  ,  -.51504418E1     ,       87

     6 -.25626822E3, .26280757   , -.36222681E-2    , .26516635E-4     ,      88

     7-.10004384E-6  ,.15423155E-9   , .90E2         , .29145189E2     ,      89

     8-.5691986E-3   , .68032634E-5  ,-.48456604E-7  , .13822647E-9    ,      90

     94.72426938     , .35642E3      , .03125117     , .15E-3          ,      91

     1  1.50         , .0101325      ,5.083          ,1.0000E2         ,      92

     2 .543507E2     , .15478E3      , .5E&3         ,1.3              ,      93

     3 .23E3         , .0            , .9E3          /                        94

C        ARGON---------------------BENDER 1970                                95

      DATA %COF%I,4<,I#1,57</         .208128    ,     .19825921       ,      96

     1-.81733119E2   , .1777747E4    ,-.82406544E6   , .31666098E8     ,      97

     2-.44202671E-1  , .6216142E2    , .11443248E4   , .4779752        ,      98

     3-.19645227E3   ,-.21572754     , .16544141E3   ,-.28142112E2     ,      99

     4 .82532059E5   ,-.91538377E7   ,-.18340752E10  ,-.33858136E7     ,     100

     5 .15532886E10  ,-.67479568E11 ,3.5  , 8*0.    , .13814448E&2    ,      101

     6-.57396331E&3  , -.18072036E&0 , .18350292E-2  ,-.10957549E-4    ,     102

     7 .36123787E-7  , -.50097228E-10, .8728E2       ,2.5              ,     103

     8 .0            , .0            , .0            , .0              ,     104

     9 2.757177  , .237932E3         , .208152       , .1E-3           ,     105

     11.48           , .0101325      ,4.865          , .5066E2         ,     106

     2 .8378E2       , .1507E3       , .1 E4         ,1.3              ,     107

     3 .25E3         , .0            , .25E4         /                       108

C        CARBON DIOXIDE------------BENDER 1970                               109

      DATA%COF %I,5<  ,I#1,57</          .188918       , .22488558     ,     110

     1-.13717965E3    ,-.14430214E5    ,-.29630491E7   ,-.20606039E9   ,     111

     2 .45554393E-1   , .77042840E2    , .40602371E5   , .40029509     ,     112

     3-.39436077E3    , .12115286      , .10783386E3   , .43962336E2   ,     113

     4-.36505545E8    , .19490511E11   ,-.29186718E13  , .24358627E8   ,     114

     5-.37546530E11   , .11898141E14   ,  5. ,8*0.     ,-.95913112E&2  ,     115

     6 .26738653E&4  , .11405373E&1  , -.67026553E-2 , .21745017E-4    ,     116

     7-.37153665E-7  , .26225608E-10   , .19471 E3     ,5.152          ,     117

     8 .015224        ,-.9681E-5       , .2313E-8      ,0.             ,     118

     94.0851019       , .72665417E3    , .095067       , .83E-5        ,     119

     11.25            ,0.010132        ,7.3835         ,.50669E2       ,     120

     2 .21656E3       , .30421E3       , .100E4        ,1.1            ,     121

     3 .37  E3        ,0.              , .25E4         /                     122

C        NEON----------------------MCCARTY AND STEWART 1965                  123

      DATA %COF%I,6<,I#1,57</        .41185435       , .42879277       ,     124

     1-.41617333E2 , -.15368388E4    , .21705583E5   , .0              ,     125

     2.5237778E-1    , .31832376E2  ,.15304725E4     , .86991276       ,     126

     3-.86565802E2   , .0            , .0            , .41994281E2     ,     127

     4 .23856729E6   ,-.10444366E8   , .0           ,-.19828098E7      ,     128

     5 .70965701E8   , .0             ,&.13590153E2  ,0.0              ,     129

     6-.12553439E-2  , -.76888021E3  ,-.84938358E3,4*0., .67422985E1   ,     130

     7-.11786837E3   ,-.19946844     , .69680979E-2  ,-.14623832E-3    ,     131

     8 .17229114E-5  ,-.83773053E-8  , 27.09         , 1.02986         ,     132

     9 .0            , .0            , .0            ,.0               ,     133

     12.4540781      , .9234824E2    , 1.            ,.00015           ,     134

     2 1.350         ,  .0101325     , 2.6537        ,.2029E2          ,     135

     3 24.54         , 44.4         ,600.            , 1.2             ,     136

     4 100.          , 0.            , 2000.         /                       137

C        CARBON MONOXIDE-----------HUST AND STEWART    1963                  138

      DATA %COF%I,7<,I#1,57</        .29692807       , .36547544       ,     139

     1-.80241533E2  ,-.16713841E5  , .13129095E6     , .0              ,     140

     2 .65308710    ,-.80131497E2  , .0              , .73365157       ,     141

     3 .0           , .0           , .0              , .41363247E3     ,     142

     4 .18061147E7  ,&.63943277E9  ,-.66472139E11    ,-.24767075E8     ,     143

     5 .96546154E10 ,-.47286423E12 , .74632444E1     , .58725319E9     ,     144

     6 .0           , .0           , 5*0.            , .13172848E2     ,     145

     7-.52482838E3   ,-.18207888     , .20385068E-2  ,-.13699320E-4    ,     146

     8 .51448459E-7  ,-.81676932E-10 ,68.14          , 1.0392602       ,     147

     9-.5033322E-5   , .26032523E-7  , .0            , .0              ,     148

     14.7928763      , .35387E3      , 1.            , .5E-4           ,     149

     2.86            ,.0101325       ,3.4986         ,.2027E2          ,     150

     3 68.14         , 132.91        , 600.          , .81             ,     151

     4 180.          , .0            , 2000.         /                       152

C        HELIUM--------------------MANN 1962                                 153

      DATA %COF%I,8<,I#1,57</         2.07722241    ,  8.44702446      ,     154

     1-.234056435E3  , .478576622E2  ,-.119375479E3  , .0              ,     155

     2 .202301846E2  , .146535214E4  ,  .0           , .0              ,     156

     3-.11186866E5   , .0            , .763244863E5  , -.70728125E5    ,     157

     4-.790460718E4  ,.545307676E5   ,  .159411473E6 ,-.182597797E7    ,     158

     5.414625688E7   , -.168878287E8 , .405704262E3  , .303082504E3    ,     159

     6 .0           , .0             , 5*0.          ,  -.21700826E1   ,     160

     7-.32255748E1  , .23561801E1    ,-.95999492     ,   .22307327     ,     161

     8-.26190460E-1 , .12190675E-2   , .42144E1      ,   .519306235E1  ,     162

     9 .0           , .0             , .0            , .0              ,     163

     A4.5053       , 36.5582         , .1E1          , .4E-4           ,     164

     B  .2100       ,  .010132       , .2274644      ,   .101325E2     ,     165

     C .3E1         , .52E1          , .600E3        , .18             ,     166

     D .35E2        , .0             , .25E4           /                     167

C     FLUORINE  BARON %BENDER< 1/72 NBS DATA USED                            168

      DATA % COF%I,9<,I#1,57< / .2188159E&0    ,     .21051539         ,     169

     1-.81175243E&02   , .23064630E&04 ,-.63183150E&06,  .96908966E&07 ,     170

     2 .25933660E&00   ,-.63689419E&02 , .68240310E&04, -.13779899E&00 ,     171

     3 .74842154E&02   , .30516478E&00 ,-.13304083E&03,  .50315749E&02 ,     172

     4 .40392186E&06   ,-.27610459E&08 ,-.42709623E&10, -.33659737E&07 ,     173

     5 .65832302E&09   ,-.61907880E&09 ,3.06E&00      ,   8*0.         ,     174

     6 .51121868E&00   ,-.35538649E&03 , .16184765E&00, -.28441699E-02 ,     175

     7 .25041457E-04   ,-.11104809E-06 , .1987869E-09 ,   84.953       ,     176

     87.0981845E&00    ,-.37629101E-02 , .26888016E-04, -.38658913E-07 ,     177

     9 .17515391E-10   ,3.8416E&00     , 63.23E&00    ,  .1101145E&00  ,     178

     A1.0E-06          ,2.25           ,  .011 E&00   , 5.215E&00      ,     179

     B 20.3E&00        , 53.48  E&00   , 144.31E&00   ,  500.E&00      ,     180

     C 1.9E&0          ,  170.E&00     ,  0.E&0       ,  450.E&01      /     181

C                                                                            182

C        PARAHYDROGEN -------------BARON %BENDER< 1971                       183

C                                                                            184

      DATA %COF%I,10<,I#1,57</4.1260486, .44446150E&2,                       185

     1-.38659604E&4,-.10966550E&6, .12080022E&7, -.54747655E&7,              186

     2-.33278647E&3, .81345734E&5, .26294257E&6, .30063983E&5,               187

     3-.33024955E&7,-.24686707E&6, .47555234E&8, -.12064332E&9,              188

     4-.49289827E&8, .15925894E&10, -.87182365E&10, .66330266E&11,           189

     5.16366622E&11, -.12954419E&14, .1050E&4, 8*0.,                         190

     6-.10593817E&1,  -.35249570E&2,  .37870039E&0,  -.23601614E-1,          191

     7.85529568E-3,  -.16180625E-4,  .12500233E-6, 20.268,                   192

     V14.7599360,-.21977388,.32100769E-2,-.12061502E-4,.57121808E-8,         193

     X21.17642,209.9406,1.0,                                                 194

     8.1E-4,  .11,  .101325E-3,  1.2928,  100.,  13.8,  32.976,              195

     A3000., .09,  60.,  0.,  1000./                                         196

      DATA %AKSTCO%I,1<,I#1,18</3.,3.,-4.,0.,0.,.983,.3891166E-2   ,         197

     1-.96910013E-1,-.16491245E-1,-.84178805E-1,.85181928,.17517383E-1       198

     2,.903089987 ,0.,0., .631,.136720567, 1.778 /                           199

C                                                                            200

C        TRANSPORT PROPERTIES ARE LIMITED BY THE STATE OF THE ART            201

C           READ REPORT ON GASP FOR COMPLETE DETAILS                         202

C                                                                            203

C                                                                            204

      DATA %AKSTCO%I,2<,I#1,18</3.,3.,-4.,0.,0., 1.0, 0.,                    205

     10.0,-1.12398985,.79352374,.80465682,-.21370471E-2,.39794,              206

     20.,0., .729, .081707270, 1.0   /                                       207

      DATA %AKSTCO%I,3<,I#1,8 </1., 3., -.22,-.10587949, -.21522105,         208

     11.31584644, .16196636 E-2  ,1.0/                                       209

C   CH4                                                                      210

      DATA%AKSTCO%I,4<,I#1,15</ 2.,4.,-.280,0.0, .86187029,.26550054,        211

     1 1.0243779, -.3075470, .238, 1.6717516,-3.6259505,2.7281748,           212

     2 .48625031, -.26386826, .71948992/                                     213

C     CH4                                                                    214

      DATA %TCCOF%I,1< , I#1,15 <  /.75226444,.20119504E-2, 190.77  ,        215

     1.1620  , 1. ,  4. ,-.9586073  ,.92583319, 1.55004971, .87042136 ,      216

     21.29907897  ,-7.01464957, .617  , 4.,   1.E-4/                         217

C     N2                                                                     218

      DATA %TCCOF%I,2< , I#1,15<   /.11425981E1,.20865873E-2, 126.3  ,       219

     1.3105   , 1.,  4., -1.39794 ,.51372790E-1,.17155947,.39312360  ,       220

     21.56022809  ,-6.85395932, .39967,2., 2.77E-5   /                       221

C     O2                                                                     222

      DATA %TCCOF%I,3< ,I#1,15<    /.96364877,.21320779E-2,  154.78    ,     223

     1.4325  , 1.  , 4.  ,-2.6383, 0.,.58701320E-1,.23887321,1.39461538,     224

     2-6.86562723 , .5132176,2.,3.40E-5/                                     225

C     AR                                                                     226

      DATA %TCCOF%I,4<, I#1,15<    /.11037087E1,.21277034E-2,150.70,         227

     1.5310   ,1.,4., -1.744727, .47325357E-1, .29305409, .72199889,         228

     21.56855570, -6.94782507, .45108,1.,2.24E-5/                            229

C     CO2                                                                    230

      DATA %TCCOF%I,5<,I#1,15<     /.98614941,.16279794 E-2, 304.2,          231

     1.4640   ,1., 4., -4.699   , .25170328E-1, .28823104, .59310573,        232

     21.5385090,-6.98446882,.4226,     3.,4.03E-5/                           233

C      NE        USING K-K* FOR ARGON WITH NE XLAM AND ZC5                   234

      DATA %TCCOF%I,6<,I#1,15</.95859  , .244676E-2  , 44.4, .483,           235

     11.,4.,-1.744727,.47325357E-1,.29305409,.72199889,1.56855570,           236

     2-6.94782507,.45108,1.,2.6E-5/                                          237

C      CO      USE N2 WITH CO CONSTANTS                                      238

      DATA %TCCOF%I,7<,I#1,15</1.127527,  .226934E-2 ,132.91,                239

     1.2997,1.,4.,-1.39794,.51372790E-1,.17155947,.39312360,1.56022809,      240

     2-6.85395932,.39967,2.,2.79E-5/                                         241

C      HE                                                                    242

      DATA %TCCOF%I,8<,I#1,15</1.536,.2579E-2,5.2,.0693,1.,4.,-1.744727,     243

     1.47325357E-1,.29305409,.72199889,1.56855570,-6.94782507,.45108,1.,     244

     25.E-5/                                                                 245

C                                                                            246

C                                                                            247

C    F2     SETUP TO LOAD DIATOMIC CURVE FOR K* EVEN THOUGH IS NOT USED      248

      DATA %TCCOF%I,9<,I#1,15</ 1.02031, .19754E-2, 144.31, .57375,          249

     1 1.,4.,-1.301, .8474771,1.3197988, .47309461, 1.3532272,               250

     2-6.3527256, .4625, 2.,1./                                              251

C     DATA   NEEDED    FOR   H2  TRANSPORT  PROPERTIES                       252

C   LOAD CRITICAL RHO AND T FOR THERM AND H2                                 253

      DATA %TCCOF%I,10<,I#1,15</2*0.,32.976,.03143,11*0./                    254

      DATA DIST/3.822,3.681,3.499,3.421,3.952,2.82,3.59,2.551,3.357,         255

     10.0/                                                                   256

      DATA EPSOK/.73E-2,1.093E-2,1.E-2,.837E-2,.5E-2,3.0488E-2,.9066E-2,     257

     19.7847E-2,.8881E-2,0.0/                                                258

      DATA WTMOL/16.04,28.016,31.9988,39.94,44.01,20.183,28.01,4.003,        259

     139.98,0.0/                                                             260

      DATA ZETA           /.46890513E-1,.40786245E-1,.30115154E-1,           261

     1.27628636E-1,.22407394E-1,.47495E-1,.402544E-1,.3843, .268525E-1,      262

     2 .40786245E-1/                                                         263

      DATA FF/ 1.015, 3*1.0, 1.02, 1.1, 1., 2.27, 1.0, 1.0/                  264

      DATA DTRIPL/.57,1.121,1.400,1.415,1.17,1.247,.836,.21,1.71,.11/        265

      DATA SWT/113.,2*68.,86.,216.,25.,70.,6.3,60.,68. /                     266

      DATA KSWT /5*1,3*2,2*1/                                                267

      DATA DIFTT/7*1.,.1,2*1./                                               268

      DATA RHOSWT/2.5,2.2,6*2.4,2.2,2.2/                                     269

      END                                                                    270

$IBFTC SETUPP

C                                                                              1

C     ---------------------------VERSION 2/1/72-------------------------       2

C     ------THIS ROUTINE OVERLAYS COFFICIENTS FOR SPECIFIED FLUID-NAMGAS       3

C     ------ IN PROGRAM COMMON BLOCKS                                          4

C     ------COEFFICIENTS FOR ALL FLUIDS ARE PRESTORED IN BLOCK DATA            5

C                                                                              6

      SUBROUTINE  SETUP %NAMGAS<                                               7

      COMMON/ALLCOF/COF%57,10<,TCCOF%15,10<,AKSTCO%18,4<,DIST%10<,             8

     1WTMOL%10<,EPSOK%10<,ZETA%10<,FF%10<,SWT%10<,KSWT%10<,DIFTT%10<,          9

     2RHOSWT%10<,DTRIPL%10<                                                   10

C       COMMON TO DETERMINE FLUID AND INFORM USER OF HIS CHOICE               11

      COMMON/GASES/MATCH%10<,MESSAG%15,10<                                    12

      COMMON/WHAT/KGAS                                                        13

C          SPECIAL SWITCHES FOR HELIUM,FLUORINE,HYDROGEN                      14

      COMMON/HELFLU/ IHE, IFL, IHY                                            15

C     COMMON FOR EQUATION OF STATE COEFFICIENTS                               16

      COMMON/BEND/ R%1<,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,             17

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                       18

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                              19

C      SATURATION CURVE COEFFICIENTS                                          20

      COMMON/COSAT/ CPS1%1<,CPS2,CPS3,CPS4,CPS5,CPS6,CPS7                     21

C      CPO CURVE COEFFICIENTS                                                 22

      COMMON/COCPO/TO%1<,CCOP1,CCOP2,CCOP3,CCOP4,CCOP5                        23

C      REFERENCE ENTROPY, ENTHALPY , CP COERRECTION FACTOR                    24

      COMMON/REFNO/SOTO,HOTO,CPOCOR,HTERM,STERM                               25

C      PARAMETERS FOR CHECKING REGION AND RANGE LIMITS ON DENSITY             26

C      PRESSURE, TEMPERATURE, ENTHALPY.  DENSITY AND TEMPERATURE ESTIMAT      27

C       NEWTON-RAPHSON ITERATIONS                                             28

      COMMON/CHECKS/DCH1%1<,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,H      29

     1SCH1,HSCH2                                                              30

C      CONSTANTS FOR THERMAL CONDUCTIVITY CALCULATION.                        31

      COMMON/TCOND/CKMKST%9<, XLAMB,ZC5, RHOCR, TCR, TCSTAR, CKSTAR%18<       32

C      CONSTANTS FOR VISCOSITY CALCULATION.                                   33

      COMMON/COFMU/EPSK,WM,DIS,RHOCRT,ZETAA                                   34

C      CONSTANTS FOR SURFACE TENSION CALCULATION.                             35

      COMMON/SURCON/PCTC,TCRIT,FIXIT,ZET                                      36

C      SWITCH FOR CP-CV CALCULATION.  VALUES IN CERTAIN REGIONS ARE           37

C       CALCULATED BY NUMERICAL DIFFERENTIATION ...WHENEVER THE ANALYTIC      38

C       DERIVATIVES ARE GOOD, THEY ARE USED.........                          39

      COMMON/SWITS/KSWIT,TSWIT,DIFT,RSWIT                                     40

      COMMON/SOLID/DTRIP                                                      41

      KGAS#0                                                                  42

      DO 10 I#1,10                                                            43

      IF%NAMGAS.EQ.MATCH%I<< KGAS#I                                           44

   10 CONTINUE                                                                45

      IF%KGAS.EQ.0< GO TO 70                                                  46

      IHE#0                                                                   47

      IF %KGAS.EQ.8< IHE#1                                                    48

        IFL#0                                                                 49

       IF %KGAS.EQ.9< IFL#1                                                   50

      IF %IFL.EQ.1< WRITE%6,72<                                               51

      IHY#0                                                                   52

      IF%KGAS.EQ.10< IHY#1                                                    53

      WRITE%6,101< %MESSAG%I,KGAS<,I#1,15<                                    54

  101 FORMAT %1H0,15A6<                                                       55

C           STORE  CONSTANTS  FOR  BENDER-S EQ. OF  STATE                     56

      DO 20 I#1,29                                                            57

   20 R%I<# COF%I,KGAS<                                                       58

C           STORE  SATURATION  CURVE  FOR  GAS                                59

      DO 25 I#30,36                                                           60

   25 CPS1%I-29< # COF%I,KGAS<                                                61

C           STORE  CPO  COEFFICIENTS  AND  REFERENCE  TO                      62

      DO 30 I#37,42                                                           63

   30 TO%I-36< # COF%I,KGAS<                                                  64

C           STORE  REFERENCE  ENTROPY,  ENTHALPY,  CPO  CORRECTION FACTO      65

      TX#TO%1<                                                                66

C    COMPUTE LOWER BOUND FOR THE ENTHALPY AND ENTROPY CALCULATIONS IN HS      67

C                                                                             68

      A1#CCOP5/4.                                                             69

      A2#CCOP4/3.                                                             70

      A3#CCOP3/2.                                                             71

      STERM     #%%%A1*TX&A2<*TX&A3<*TX&CCOP2<*TX&CCOP1*ALOG%TX<              72

      A1#CCOP5/5.                                                             73

      A2#CCOP4/4.                                                             74

      A3#CCOP3/3.                                                             75

      A4#CCOP2/2.                                                             76

      HTERM     #%%%%A1*TX&A2<*TX&A3<*TX&A4<*TX&CCOP1<*TX                     77

      IF%IHY.EQ.1< STERM#4.968*4.184/2.01572*ALOG%TX<                         78

      IF %IHY.EQ.1< HTERM#4.968*4.184/2.01572*TX                              79

      SOTO# COF%43,KGAS<                                                      80

      HOTO# COF%44,KGAS<                                                      81

      CPOCOR#COF%45,KGAS<                                                     82

C           STORE CRITICAL VALUES AND REGION BOUNDARY CONSTANTS               83

      DO 35 I#46,57                                                           84

   35 DCH1%I-45< # COF%I,KGAS<                                                85

      XLAMB# TCCOF%1,KGAS<                                                    86

      ZC5# TCCOF%2,KGAS<                                                      87

      TCR# TCCOF%3,KGAS<                                                      88

      RHOCR # TCCOF%4,KGAS<                                                   89

C           LOAD K-K*  CURVE COEFFICIENTS                                     90

      DO 45  I#5,13                                                           91

   45 CKMKST%I-4<# TCCOF%I,KGAS<                                              92

      TCSTAR# TCCOF%15,KGAS<                                                  93

      I# TCCOF%14,KGAS<&.1                                                    94

C                             LOAD  KSTAR/KSTARTC   CURVE  COEFFICIENTS       95

      DO 50  J#1,18                                                           96

   50 CKSTAR%J<# AKSTCO%J,I<                                                  97

C      STORE CONSTANTS FOR U-U* AND VISCOSITY CALCULATION                     98

      WM#WTMOL%KGAS<                                                          99

      ZETAA#ZETA%KGAS<                                                       100

      RHOCRT#TCCOF%4,KGAS<                                                   101

      EPSK #EPSOK%KGAS<                                                      102

      DIS#DIST%KGAS<                                                         103

C       STORE CONSTANTS FOR SURFACE TENSION %  RF IS RIEDEL FACTOR<          104

      TCRIT#TCH2                                                             105

      PCTC#%PCH2/.101325<**%2./3.<*TCH2**%1./3.<                             106

      FIXIT#FF%KGAS<                                                         107

      ZET#ZC5**%1./5.<                                                       108

C  ENTER SWITCHING PARAMETER FOR CP,CV CALCULATION                           109

      KSWIT#KSWT%KGAS<                                                       110

      TSWIT#SWT%KGAS<                                                        111

      IF %KSWIT.EQ.2< TSWIT#TCH2                                             112

      DIFT#DIFTT%KGAS<                                                       113

      RSWIT#RHOSWT%KGAS< *RHOCRT                                             114

      DTRIP#DTRIPL%KGAS<                                                     115

      RETURN                                                                 116

   70 WRITE%6,71<                                                            117

   71 FORMAT%1H0, 69H  ERROR IN CODE FOR NAMGAS - NO CONSTANTS STORED-       118

     2 PROGRAM  STOP.      <                                                 119

   72 FORMAT%1H0,115H THE REGION 125-145K FOR T AND P GREATER THAN 10        120

     1ATM YIELDS POOR RESULTS FOR THE DERIVED PROEPRTIES--BEWARE.      <     121

      STOP                                                                   122

      END                                                                    123

$IBFTC SCHEC

C                                                                              1

C     ---------------------------VERSION 2/1/72-------------------------       2

C                                                                              3

      FUNCTION   CHECK%KU,KR,T<                                                4

      COMMON/ CON123/ DCONV%5<,TCONV%5<,PCONV%5<                               5

      COMMON/IERROR/ IROUT                                                     6

      COMMON/CHECKS/DCH1,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,           7

     1HSCH1,HSCH2                                                              8

      DIMENSION   FM1%9<, FM2%9<, FM3%9<, FMT%9<, ROUT%13<                     9

      DATA  FM1  /51H%1H ,G12.4 ,31HIS OUT OF RANGE FOR T  IN SUB.-,A6 <      10

     1/                                                                       11

      DATA  FM2  /51H%1H ,G12.4 ,31HIS OUT OF RANGE FOR P  IN SUB.-,A6 <      12

     1  /                                                                     13

      DATA  FM3  /51H%1H ,G12.4 ,31HIS OUT OF RANGE FOR D  IN SUB.-,A6 <      14

     1  /                                                                     15

      DATA  ROUT /4HDENS,5HPRESS,4HTEMP ,4HENTH,3HENT ,6HTEMPPH,6HTEMPPS      16

     1,5HSONIC,5HSPCHP,5HSPCHV,5HTHERM,4HVISC,4HSURF   /                      17

C                                                                             18

C        CONVERT TEMPERATURE T TO DEGREES KELVIN AND CHECK                    19

C        FOR OUT OF RANGE.  UNITS ARE SPECIFIED BY KU.  IF KR                 20

C        IS SPECIFIED AS 1, T IS CHECKED FOR OUT OF SATURATION                21

C        RANGE.                                                               22

C                                                                             23

      ENTRY   TCHECK %KU,KR,T<                                                24

      CHECK#T/TCONV%KU<                                                       25

      CH1#TCH1                                                                26

      CH2#TCH2                                                                27

      CH3#TCH3                                                                28

      DO 1 J#1,9                                                              29

    1 FMT%J<#FM1%J<                                                           30

      GO TO 10                                                                31

C                                                                             32

C        CONVERT PRESSURE P TO ATMOSPHERES AND CHECK                          33

C        FOR OUT OF RANGE.  UNITS ARE SPECIFIED BY KU. IF KR IS               34

C        SPECIFIED AS 1, P IS CHECKED FOR OUT OF SATURATION                   35

      ENTRY  PCHECK%KU,KR,P<                                                  36

      CHECK#P/PCONV%KU<                                                       37

      CH1# PCH1                                                               38

      CH2# PCH2                                                               39

      CH3# PCH3                                                               40

      DO 2 J#1,9                                                              41

    2 FMT%J<#FM2%J<                                                           42

      GO TO 10                                                                43

C                                                                             44

C        CONVERT DENSITY D TO GRAM-MOLES/LITER AND CHECK                      45

C        FOR OUT OF RANGE.  UNITS ARE SPECIFIED BY KU.                        46

C                                                                             47

      ENTRY DCHECK%KU,D<                                                      48

      CHECK #D/DCONV%KU<                                                      49

      CH1#DCH1                                                                50

      CH3#DCH2                                                                51

      DO 3 J#1,9                                                              52

    3 FMT%J<#FM3%J<                                                           53

      GO TO 20                                                                54

   10 IF%KR.EQ.1< GO TO 30                                                    55

   20 IF%CHECK.LT.CH1< GO TO 40                                               56

      IF%CHECK.GT.CH3< GO TO 40                                               57

   25 RETURN                                                                  58

   30 IF%CHECK.LT.CH1< GO TO 40                                               59

      IF%CHECK.LE.CH2< GO TO 25                                               60

   40 WRITE%6,FMT< CHECK,ROUT%IROUT<                                          61

      RETURN                                                                  62

      END                                                                     63

$IBFTC ROOT

      SUBROUTINE ROOT %X0,X2,FOFX,FUNC,X1<                                     1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        SAME AS ROOTX - NEEDED  TO  PREVENT  RECURSION                        4

C        SOLVE FOR X1 SUCH THAT FUNC%X1< # FOFX, WHERE X1 LIES                 5

C        BETWEEN X0 AND X2                                                     6

C                                                                              7

      COMMON /CHECK1/KOUNT                                                     8

      TOL#1.E-5                                                                9

      XX0 # X0                                                                10

      XX2 # X2                                                                11

      F0 # FUNC%XX0<                                                          12

      F2 # FUNC%XX2<                                                          13

      A#%FOFX-F0</%F2-F0<                                                     14

      IF %A< 1007,120,120                                                     15

  120 IF %A-1.< 130,130,1008                                                  16

  130 IF %FOFX-0.< 80,70,80                                                   17

   70 ASSIGN 100 TO JUMP                                                      18

      GO TO 90                                                                19

   80 ASSIGN 110 TO JUMP                                                      20

   90 X # %XX0&XX2</2.                                                        21

      KOUNT # 0                                                               22

  150 X1 # X                                                                  23

      KOUNT # KOUNT & 1                                                       24

      A # FOFX - F2                                                           25

      FX # FUNC%X<                                                            26

      FXL#F0&%X-XX0<*%F2-F0</%XX2-XX0<                                        27

      B#ABS%%FX-FXL</%F2-F0<<                                                 28

      IF %A*%FX-FOFX< .LT. 0.< GO TO 1001                                     29

      XX0 # X                                                                 30

      F0#FX                                                                   31

      IF %B-.3< 10,20,20                                                      32

   20 X # %X&XX2</2.                                                          33

      GO TO 40                                                                34

 1001 XX2 # X                                                                 35

      F2 # FX                                                                 36

      IF %B-.3< 10,30,30                                                      37

   30 X # %XX0&X</2.                                                          38

      GO TO 40                                                                39

   10 X#XX0&%FOFX-F0<*%XX2-XX0</%F2-F0<                                       40

   40 IF %ABS%%X-X1</X<-TOL  < 50,1000,1000                                   41

   50 GO TO JUMP,%100,110<                                                    42

  100 IF %ABS%FUNC%X<<-TOL*10. <60,1000,1000                                  43

  110 IF %ABS%%FOFX-FUNC%X<</FOFX<-TOL  < 60,1000,1000                        44

 1000 IF %KOUNT.GT.40< TOL#TOL*10.                                            45

      IF %KOUNT.GT.60< TOL#TOL*10.                                            46

      IF %KOUNT.GT.80< TOL#TOL*10.                                            47

      IF %KOUNT.LT.100< GO TO 150                                             48

  160 WRITE %6,170< X1,X                                                      49

  170 FORMAT %1HL,79HAN ITERATION HAS BEEN TERMINATED AT 100 ITERATIONS.      50

     1  THE LAST TWO VALUES WERE  ,3G15.5<                                    51

   60 X1#X                                                                    52

      RETURN                                                                  53

 1007 X1 # X0                                                                 54

      GO TO 140                                                               55

 1008 X1 # X2                                                                 56

  140 WRITE%6,141<                                                            57

  141 FORMAT%1H0,24H SOLUTION OUT OF RANGE         <                          58

      RETURN                                                                  59

      END                                                                     60

$IBFTC ROOTX

C     ---------------------------VERSION 2/1/72-------------------------       1

      SUBROUTINE ROOTX%X0,X2,FOFX,FUNC,X1<                                     2

C                                                                              3

C        SOLVE FOR X1 SUCH THAT FUNC%X1< # FOFX, WHERE X1 LIES                 4

C        BETWEEN X0 AND X2                                                     5

C                                                                              6

      COMMON /CHECK2/KOUNT                                                     7

      TOL#1.E-5                                                                8

      XX0 # X0                                                                 9

      XX2 # X2                                                                10

      F0 # FUNC%XX0<                                                          11

      F2 # FUNC%XX2<                                                          12

      A#%FOFX-F0</%F2-F0<                                                     13

      IF %A< 1007,120,120                                                     14

  120 IF %A-1.< 130,130,1008                                                  15

  130 IF %FOFX-0.< 80,70,80                                                   16

   70 ASSIGN 100 TO JUMP                                                      17

      GO TO 90                                                                18

   80 ASSIGN 110 TO JUMP                                                      19

   90 X # %XX0&XX2</2.                                                        20

      KOUNT # 0                                                               21

  150 X1 # X                                                                  22

      KOUNT # KOUNT & 1                                                       23

      A # FOFX - F2                                                           24

      FX # FUNC%X<                                                            25

      FXL#F0&%X-XX0<*%F2-F0</%XX2-XX0<                                        26

      B#ABS%%FX-FXL</%F2-F0<<                                                 27

      IF %A*%FX-FOFX< .LT. 0.< GO TO 1001                                     28

      XX0 # X                                                                 29

      F0#FX                                                                   30

      IF %B-.3< 10,20,20                                                      31

   20 X # %X&XX2</2.                                                          32

      GO TO 40                                                                33

 1001 XX2 # X                                                                 34

      F2 # FX                                                                 35

      IF %B-.3< 10,30,30                                                      36

   30 X # %XX0&X</2.                                                          37

      GO TO 40                                                                38

   10 X#XX0&%FOFX-F0<*%XX2-XX0</%F2-F0<                                       39

   40 IF %ABS%%X-X1</X<-TOL  < 50,1000,1000                                   40

   50 GO TO JUMP,%100,110<                                                    41

  100 IF %ABS%FUNC%X<<-TOL*10. <60,1000,1000                                  42

  110 IF %ABS%%FOFX-FUNC%X<</FOFX<-TOL  < 60,1000,1000                        43

 1000 IF %KOUNT.GT.40< TOL#TOL*10.                                            44

      IF %KOUNT.GT.60< TOL#TOL*10.                                            45

      IF %KOUNT.GT.80< TOL#TOL*10.                                            46

      IF %KOUNT.LT.100< GO TO 150                                             47

  160 WRITE %6,170< X1,X                                                      48

  170 FORMAT %1HL,79HAN ITERATION HAS BEEN TERMINATED AT 100 ITERATIONS.      49

     1  THE LAST TWO VALUES WERE  ,3G15.5<                                    50

   60 X1#X                                                                    51

      RETURN                                                                  52

 1007 X1 # X0                                                                 53

      GO TO 140                                                               54

 1008 X1 # X2                                                                 55

  140 WRITE%6,141<                                                            56

  141 FORMAT%1H0,24H SOLUTION OUT OF RANGE         <                          57

      RETURN                                                                  58

      END                                                                     59

$IBFTC SPLIN

C     ---------------------------VERSION 2/1/72-------------------------       1

      SUBROUTINE SPLINA%X,Y,NX,T,NT,YINT,KFD,KERROR<                           2

      DIMENSION X%1<, Y%1<,T%1<,YINT%1<,U%50<,XM%1<                            3

      EQUIVALENCE %XM%1<, U%1<<                                                4

      NXM1# NX-1                                                               5

      NXP1 # NX&1                                                              6

      H# X%2<-X%1<                                                             7

      KERROR#0                                                                 8

      H2 # H*H                                                                 9

      YINT%1<# .5                                                             10

      U%1<# 0.                                                                11

      DO 10 I#2,NXM1                                                          12

      P# .5*YINT%I-1<&2.                                                      13

      YINT%I<# -.5/P                                                          14

      D # 3.*%%Y%I&1<-Y%I<<-%Y%I<-Y%I-1<<</H2                                 15

   10 U%I<# %D-.5*U%I-1<</P                                                   16

      P #-.5*YINT%NXM1<&1.                                                    17

      YINT%NX<# 0.                                                            18

      U%NX<# .5*U%NXM1</P                                                     19

      XM%NX< # U%NX<                                                          20

      DO 20 I#2,NX                                                            21

      K# NXP1 -I                                                              22

   20 XM%K<# YINT%K<*XM%K&1<&U%K<                                             23

      DO 90 I#1,NT                                                            24

      K#2                                                                     25

      IF%T%I<-X%1<<60,85,70                                                   26

   60 WRITE%6,600< T%1<, X%1<, X%NX<                                          27

  600 FORMAT%1HL,40H AN ERROR OCCURRED DURING INTERPOLATION /                 28

     1           96H THE X WHERE INTERPOLATION DESIRED %XINT< IS OUT OF       29

     2RANGE.  THE ROUTINE WILL TRY TO EXTRAPOLATE./ 6H XINT#G15.7,    6H      30

     3 X%1<#G15.7, 6H X%N<#G15.7  <                                           31

      KERROR # KERROR&1                                                       32

      GO TO 85                                                                33

   70 IF%T%I<-X%K<< 85,85,80                                                  34

   80 K# K&1                                                                  35

      IF%K-NX< 70,70,81                                                       36

   81 KERROR # KERROR&1                                                       37

      WRITE%6,600< T%I<, X%1<, X%NX<                                          38

      K#NX                                                                    39

   85 IF %KFD< 40,40,50                                                       40

   40 YINT%I<#%XM%K-1<*%X%K<-T%I<<**3&XM%K<*%T%I<-X%K-1<<**3&%6.*Y%K-1<-      41

     1XM%K-1<*H2<*%X%K<-T%I<<&%6.*Y%K<-XM%K<*H2<*%T%I<-X%K-1<<</%6.*H<        42

      GO TO 90                                                                43

   50 YINT%I<#%-XM%K-1<*%X%K<-T%I<<**2/2.&XM%K<*%T%I<-X%K-1<<**2/2.&          44

     1Y%K<-Y%K-1<-%XM%K<-XM%K-1<<*H2/6.</H                                    45

   90 CONTINUE                                                                46

      RETURN                                                                  47

      END                                                                     48

$IBFTC POLY

C     ---------------------------VERSION 2/1/72-------------------------       1

      FUNCTION POLY%X,COEF<                                                    2

C                                                                              3

C        EVALUATE THE POLYNOMIAL IN X DESCRIBED BY COEF                        4

C                                                                              5

      DIMENSION COEF%1<                                                        6

      XS#X                                                                     7

      NRANGE#COEF%1<&.1                                                        8

      NDEG#COEF%2<&.1                                                          9

      ISTEP#NDEG&2                                                            10

      ITEST#3&NRANGE*ISTEP                                                    11

      IF %XS-COEF%3<< 10,20,20                                                12

   20 IF %XS-COEF%ITEST<< 30,30,40                                            13

   30 IBEG#3&ISTEP                                                            14

      IEND#ITEST-ISTEP                                                        15

      DO 50 I#IBEG,IEND,ISTEP                                                 16

      IF %XS-COEF%I<< 60,60,50                                                17

   50 CONTINUE                                                                18

      I#ITEST                                                                 19

      GO TO 60                                                                20

   10 I#3&ISTEP                                                               21

      GO TO 70                                                                22

   40 I#ITEST                                                                 23

   70 WRITE%6,71< XS                                                          24

   71 FORMAT%1H0,E14.5,60H IS OUT OF RANGE OF CURVE FIT  VALUE IS EXTRAP      25

     1OLATED.         <                                                       26

   60 IBEG#I-ISTEP&2                                                          27

      IEND#IBEG&NDEG-1                                                        28

      POLY#COEF%IBEG-1<                                                       29

      DO 80 I#IBEG,IEND                                                       30

   80 POLY#POLY*XS&COEF%I<                                                    31

      RETURN                                                                  32

      END                                                                     33

$IBFTC SOLVE

C     ---------------------------VERSION 2/1/72-------------------------       1

      FUNCTION SOLVE%XI,F,DF<                                                  2

C                                                                              3

C        NEWTON-RAPHSON ITERATION GIVEN AN INITIAL ESTIMATE XI                 4

C        AND THE FUNCTIONS F AND DF                                            5

      COMMON /CHECK1/NI                                                        6

      TOL#1.E-5                                                                7

      NI#0                                                                     8

      XO#XI                                                                    9

      XN#XI                                                                   10

   10 XOO#XO                                                                  11

      XO#XN                                                                   12

      XN#XO-F%XO</DF%XO<                                                      13

   12 NI#NI&1                                                                 14

      IF %ABS%%XN-XO</XN<-TOL  < 70,20,20                                     15

   20 IF %NI.GT.40< TOL#TOL*10.                                               16

      IF %NI.GT.60< TOL#TOL*10.                                               17

      IF %NI.GT.80< TOL#TOL*10.                                               18

      IF %NI-100< 30,50,50                                                    19

   30 IF %ABS%%XN-XOO</XN<-TOL  < 40,10,10                                    20

   40 XN#%XO&XN</2.                                                           21

      GO TO 10                                                                22

   50 WRITE %6,60< XOO,XO,XN                                                  23

   60 FORMAT %1HL,81HAN ITERATION HAS BEEN TERMINATED AT 100 ITERATIONS.      24

     1  THE LAST THREE VALUES WERE  ,3G15.5<                                  25

   70 SOLVE#XN                                                                26

      IF %XN.GE.0.< RETURN                                                    27

      SOLVE#XI                                                                28

      WRITE%6,75< XI                                                          29

   75 FORMAT%1H ,82H N-R ITERATION DID NOT FIND A VALID ANSWER. INITIAL       30

     1 ESTIMATE RETURNED AS ANSWER.        E12.6<                             31

      RETURN                                                                  32

      END                                                                     33

$IBFTC GUES

      SUBROUTINE DGUESS%TS,TCR,DST<                                            1

C    ---------------------------VERSION 2/1/72                                 2

      COMMON/COFMU/EPSK,WM,DIS,RHOCRT,ZETAA                                    3

      IF %TS/TCR.GT..9< DST#RHOCRT*1.75                                        4

      IF %TS/TCR.GT..96<DST#RHOCRT*1.60                                        5

      IF %TS/TCR.GT..98<DST#RHOCRT*1.50                                        6

      IF %TS/TCR.GT..993<DST # RHOCRT*1.4                                      7

      IF %TS/TCR.GT..998<DST # RHOCRT*1.30                                     8

      IF %TS/TCR.GT..999<  DST#RHOCRT*1.20                                     9

      IF %TS/TCR.GT..9995< DST#RHOCRT*1.10                                    10

      IF %TS/TCR.GT..9999< DST#RHOCRT*1.05                                    11

      END                                                                     12

$IBFTC DENS1

      SUBROUTINE DENS%KU,T,P,D,DL,DV,KR<                                       1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

      COMMON/ CON123/ DCONV%5<,TCONV%5<,PCONV%5<                               4

C        COMPUTE DENSITY D GIVEN TEMPERATURE T AND PRESSURE P.                 5

C        UNITS ARE SPECIFIED BY KU.  IF KR IS RETURNED OR                      6

C        SPECIFIED AS 1, THE SATURATED LIQUID AND VAPOR DENSITIES,             7

C        DL AND DV RESPECTIVELY, ARE COMPUTED AS A FUNCTION                    8

C        OF T OR P.  THE OTHER VALUE MUST BE INPUT AS 0.0 .                    9

C                                                                             10

      COMMON /CHECK1/NI                                                       11

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,             12

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                       13

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                              14

      COMMON/BEND13/A1,A4,A5,A6,A7,A8,A9,A99,PS                               15

      COMMON/BEND15/A10,A11,A12,A13,A14                                       16

      COMMON/BEND17/TS                                                        17

      COMMON/CHECKS/DCH1,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,          18

     1HSCH1,HSCH2                                                             19

      COMMON/COFMU/EPSK,WM,DIS,RHOCRT,ZETAA                                   20

      COMMON/HELFLU/ IHE, IFL, IHY                                            21

      COMMON/SOLID/DTRIP                                                      22

      COMMON /IERROR/IROUT                                                    23

      EXTERNAL DSF,DDSF                                                       24

      IROUT#1                                                                 25

      IF %KR.EQ.1< GO TO 70                                                   26

      TS#TCHECK%KU,KR,T<                                                      27

      GO TO 5                                                                 28

   70 IF %T.GT.0.0< GO TO 75                                                  29

      PS#PCHECK%KU,KR,P<                                                      30

      TS#TSS%PS<                                                              31

      IF %T.LE.0.< T#TS*TCONV%KU<                                             32

      GO TO  5                                                                33

   75 TS#TCHECK%KU,KR,T<                                                      34

      CALL  PSSS%PS<                                                          35

      IF %P.LE.0.< P#PS*PCONV%KU<                                             36

    5 T2#1.0                                                                  37

      IF %IHE.EQ.1< T2#TS                                                     38

C                                                                             39

C   COMPUTATIONS COMMON TO ALL REGIONS                                        40

C                                                                             41

      A1# R*TS                                                                42

      A2# 1./TS                                                               43

      A3# A2*A2                                                               44

      A4#%%%%CP25*A3 & CP21<*A2&CP5<*A2&CP4<*A2&CP3<*A2&CP2&CP1*TS            45

      A5#%CP23*A2&CP8<*A2&CP7&%CP22*TS&CP6<*TS                                46

      A6# CP9*TS&CP10                                                         47

      A7# CP11*TS&CP12 &CP24*A2                                               48

      A8#%%CP16*A2&CP15<*A2&CP14<*A3                                          49

      A9#%%CP19*A2&CP18<*A2&CP17<*A3                                          50

      A99#%%CP28*A2&CP27<*A2&CP26<*A3                                         51

      A10#-2.*CP20/T2                                                         52

      A11#6.*CP13                                                             53

      A12#5.*A7                                                               54

      A13# 4.*A6                                                              55

      A14# 2.*A4                                                              56

C                                                                             57

C        DETERMINE REGION                                                     58

C                                                                             59

      IF %KR-1< 10,80,10                                                      60

   10 PS#PCHECK%KU,KR,P<                                                      61

      IF %PS-PCH2<110,110,100                                                 62

  100 IF %TS-TCH2<120,120,130                                                 63

  120 KR#2                                                                    64

      EST#RHOCRT*.90                                                          65

      CALL ROOT%DCH2,EST,0.,DSF,DS<                                           66

      GO TO 150                                                               67

  130 KR#3                                                                    68

      EST#RHOCRT*3.                                                           69

      CALL ROOT%EST,DCH1,0.,DSF,DS<                                           70

      GO TO 150                                                               71

  110 IF %TS-TCH2< 20,20,50                                                   72

   20 CALL PSSS%PSS<                                                          73

      IF %ABS%%PSS-PS</PSS<-1.E-4< 60,30,30                                   74

   30 IF %PS-PSS< 50,60,40                                                    75

   40 KR#2                                                                    76

      DS#DST                                                                  77

      IF %TS/TCH2.LT..90.OR.PS/PSS.LT..95*PSS< GO TO 90                       78

      CALL DGUESS%TS,TCH2,DS<                                                 79

      GO TO 90                                                                80

   50 KR#3                                                                    81

      DS#PS/%R*TS</2.                                                         82

      GO TO 90                                                                83

C                                                                             84

C        REGION 1                                                             85

C                                                                             86

   60 KR#1                                                                    87

   80 CONTINUE                                                                88

      DS#DST                                                                  89

      IF %TCH2-TS.LT.1.E-4< GO TO 84                                          90

      IF %TCH2-TS.LT..10< GO TO 81                                            91

      CALL DGUESS%TS,TCH2,DS<                                                 92

      DSL#SOLVE%DS, DSF,DDSF<                                                 93

      DS#PS/%R*TS</2.                                                         94

      IF %TS/TCH2.GT..985<DS#.65*RHOCRT                                       95

      IF %TS/TCH2.GT..995< DS#.75*RHOCRT                                      96

      IF %TS/TCH2.GT..999< DS#.85*RHOCRT                                      97

      IF %TS/TCH2.GT..9995< DS#.90*RHOCRT                                     98

      DSV#SOLVE%DS,DSF,DDSF<                                                  99

      DL#DSL*DCONV%KU<                                                       100

      DV#DSV*DCONV%KU<                                                       101

      RETURN                                                                 102

   81 DL#RHOCRT*DCONV%KU<*1.001                                              103

      DV#RHOCRT*DCONV%KU<*.999                                               104

C                                                                            105

C      THIS FIX IS APPLIED IN THE NEAR SUBCRITICAL AREA TO COMPENSATE FO     106

C     THE FAILURE OF NEWTON-RAPHSON TO CONVERGE ON A DENSITY WITHOUT A V     107

C     ACCURATE ESTIMATE.  PERHAPS ROOTX SHOULD BE USED IN THE REGION         108

C       T/TCRT .GT..99 TO PREVENT THIS PROBLEM                               109

C      IF YOU WANT AN ERROR MESSAGE WHEN THIS HAPPENS REMOVE THE C-S FRO     110

C      FOLLOWING THREE CARDS.                                                111

C     WRITE%6,82< TS                                                         112

C  82 FORMAT%1H ,25H SATURATION CALL FOR TS# ,F10.3,65H IS TOO NEAR CRIT     113

C    1ICAL.  DL#1.001*RHOCRT  DV#.999*RHOCRT                <                114

      RETURN                                                                 115

   84 DL#RHOCRT*DCONV%KU<                                                    116

      DV#DL                                                                  117

      RETURN                                                                 118

C                                                                            119

C        REGIONS 2 AND 3                                                     120

C                                                                            121

   90 DS#SOLVE%DS,DSF,DDSF<                                                  122

  150 D#DS*DCONV%KU<                                                         123

      IF %DS.GT.DTRIP< WRITE%6,152< T,P                                      124

  152 FORMAT%1H ,  98H DENSITY SOLUTION IS BEYOND THE GRASP OF GASP. ANS     125

     1WER IS ON SOLID SIDE OF MELTING LOCUS FOR T #   F9.0,6H P #  ,F10.     126

     23,4H MN.   <                                                           127

      RETURN                                                                 128

      END                                                                    129

$IBFTC DSUB1

      FUNCTION DSF%DS<                                                         1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        FUNCTION USED TO SOLVE FOR DENSITY DS GIVEN TEMPERATURE               4

C        AND PRESSURE                                                          5

C                                                                              6

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              7

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        8

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               9

      COMMON/BEND13/A1,A4,A5,A6,A7,A8,A9,A99,PS                               10

      COMMON/BEND15/A10,A11,A12,A13,A14                                       11

      COMMON/HELFLU/ IHE, IFL, IHY                                            12

      COMMON/BEND17/TS                                                        13

      T2#1.0                                                                  14

      IF %IHE.EQ.1< T2#TS                                                     15

      B1#EXP%-CP20*DS*DS/T2<                                                  16

      B2# A8*B1                                                               17

      B3# A9*B1                                                               18

      B4#A99*B1                                                               19

      DSF#%%%%%%B4*DS&CP13<*DS&A7&B3<*DS&A6<*DS&A5&B2<*DS&A4<*DS              20

     1 &A1<*DS-PS                                                             21

      RETURN                                                                  22

      ENTRY DDSF%DS<                                                          23

C                                                                             24

C        DERIVATIVE OF FUNCTION USED TO SOLVE FOR DENSITY DS GIVEN            25

C        TEMPERATURE AND PRESSURE                                             26

C                                                                             27

      DDSF#%%%%%%A10*%B4*DS*DS&B3<&7.*B4<*DS&A11<*DS&A12&%5.*A9&A10*A8<*      28

     1B1<*DS&A13<*DS&3.*%A5&A8*B1<<*DS&A14<*DS&A1                             29

      DSF#DDSF                                                                30

      RETURN                                                                  31

      END                                                                     32

$IBFTC PRES1

      SUBROUTINE PRESS%KU,T,D,P,KR<                                            1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE PRESSURE P GIVEN TEMPERATURE T AND DENSITY D.                 4

C        UNITS ARE SPECIFIED BY KU.  IF KR IS RETURNED OR                      5

C        SPECIFIED AS 1, P IS COMPUTED AT SATURATION AS A                      6

C        FUNCTION OF T ONLY.                                                   7

C                                                                              8

      COMMON/ CON123/ DCONV%5<,TCONV%5<,PCONV%5<                               9

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,             10

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                       11

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                              12

      COMMON/CHECKS/DCH1,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,          13

     1HSCH1,HSCH2                                                             14

      COMMON/BEND17/TS                                                        15

      COMMON/HELFLU/ IHE, IFL, IHY                                            16

      COMMON /IERROR/IROUT                                                    17

      IROUT#2                                                                 18

C                                                                             19

C        DETERMINE REGION                                                     20

C                                                                             21

      TS#TCHECK%KU,KR,T<                                                      22

      T2#1.0                                                                  23

      IF %IHE.EQ.1< T2#TS                                                     24

      IF %KR-1< 10,70,10                                                      25

   10 DS#DCHECK%KU,D<                                                         26

      IF %TS-TCH2< 20,20,50                                                   27

   20 CALL DENS%1,TS,ZE,ZE,DSL,DSV,1<                                         28

      IF %DS-DSL< 30,60,40                                                    29

   30 IF %DS-DSV< 50,60,60                                                    30

   40 KR#2                                                                    31

      GO TO 80                                                                32

   50 KR#3                                                                    33

      GO TO 80                                                                34

C                                                                             35

C        REGION 1                                                             36

C                                                                             37

   60 KR#1                                                                    38

   70 CALL PSSS%PS<                                                           39

      GO TO 90                                                                40

C                                                                             41

C        REGIONS 2 AND 3                                                      42

C                                                                             43

   80 A1# R*TS                                                                44

      A2 # 1./TS                                                              45

      A3 # A2*A2                                                              46

      A4#%%%%CP25*A3&CP21<*A2&CP5<*A2&CP4<*A2&CP3<*A2&CP2&CP1*TS              47

      A5#%CP23*A2&CP8<*A2&CP7&%CP22*TS&CP6<*TS                                48

      A6 # CP9*TS&CP10                                                        49

      A7# CP11*TS&CP12 &CP24*A2                                               50

      A8 # %%CP16*A2&CP15<*A2&CP14<*A3                                        51

      A9 # %%CP19*A2&CP18<*A2&CP17<*A3                                        52

      B1#EXP%-CP20*DS*DS/T2<                                                  53

      A10#%%CP28*A2&CP27<*A2&CP26<*A3*B1                                      54

      PS#%%%%%%A10*DS&CP13<*DS&A7&A9*B1<*DS&A6<*DS&A5&A8*B1<*DS&A4<*DS&       55

     1A1<*DS                                                                  56

   90 P#PS*PCONV%KU<                                                          57

      RETURN                                                                  58

      END                                                                     59

$IBFTC TEMP1

      SUBROUTINE TEMP%KU,P,D,T,KR<                                             1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE TEMPERATURE T GIVEN PRESSURE P AND DENSITY D.                 4

C        UNITS ARE SPECIFIED BY KU.  IF KR IS RETURNED OR                      5

C                                                                              6

      COMMON/ CON123/ DCONV%5<,TCONV%5<,PCONV%5<                               7

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              8

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        9

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                              10

      COMMON/HELFLU/ IHE, IFL, IHY                                            11

      COMMON/CHECKS/DCH1,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,          12

     1HSCH1,HSCH2                                                             13

      COMMON/BEND3/DS,A1,A3,A4,A5,A6B,A7B,A8B,A12,G1                          14

      COMMON /IERROR/IROUT                                                    15

      IROUT#3                                                                 16

      EXTERNAL TSF,DTSF                                                       17

      PS#PCHECK%KU,KR,P<                                                      18

C                                                                             19

C        DETERMINE REGION                                                     20

C                                                                             21

      IF %KR-1< 10,70,10                                                      22

   10 DS#DCHECK%KU,D<                                                         23

      IF %PS-PCH2< 20,20,50                                                   24

   20 TS#TSS%PS<                                                              25

      CALL DENS%1,TS,ZE,ZE,DSL,DSV,1<                                         26

      IF %DS-DSL< 30,60,40                                                    27

   30 IF %DS-DSV< 50,60,60                                                    28

   40 KR#2                                                                    29

      TS#TS-10.                                                               30

      IF %IHE.EQ.1< TS#3.0                                                    31

      GO TO 80                                                                32

   50 KR#3                                                                    33

      TS#TST                                                                  34

      GO TO 80                                                                35

C                                                                             36

C        REGION 1                                                             37

C                                                                             38

   60 KR#1                                                                    39

      GO TO 110                                                               40

   70 TS#TSS%PS<                                                              41

      GO TO 110                                                               42

C                                                                             43

C        REGIONS 2 AND 3                                                      44

C                                                                             45

   80 A1# DS*DS                                                               46

      A3 #%%%%CP13*DS&CP12<*DS&CP10<*DS&CP7<*DS&CP2<*A1 -PS                   47

      A4 # %%%%CP11*DS&CP9<*DS&CP6<*DS&CP1<*DS&R<*DS                          48

      A5#%%CP24*A1&CP8<*DS&CP3<*A1                                            49

      A6B# %CP23*DS&CP4<*A1                                                   50

      A7B#CP5*A1                                                              51

      A8B#CP21*A1                                                             52

      A12 #2.*CP22*A1*DS                                                      53

      G1#CP25*A1                                                              54

      TS#SOLVE%TS,TSF,DTSF<                                                   55

C                                                                             56

C        VERIFY REGION                                                        57

C                                                                             58

      IF %PS-PCH2<110,110,90                                                  59

   90 IF %TS-TCH2< 100,100,110                                                60

  100 KR#2                                                                    61

  110 T#TS*TCONV%KU<                                                          62

      RETURN                                                                  63

      END                                                                     64

$IBFTC TSUB1

      FUNCTION TSF%TS<                                                         1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        FUNCTION USED TO SOLVE FOR TEMPERATURE TS GIVEN PRESSURE              4

C        AND DENSITY                                                           5

C                                                                              6

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              7

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        8

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               9

      COMMON/HELFLU/ IHE, IFL, IHY                                            10

      COMMON/BEND3/DS,A1,A3,A4,A5,A6B,A7B,A8B,A12,G1                          11

      T2#1.0                                                                  12

      IF %IHE.EQ.1< T2#TS                                                     13

      A2#DS*EXP%-CP20*DS*DS/T2<                                               14

      A6A#%%CP26*A1&CP17<*A1&CP14<*A1*A2                                      15

      A7A#%%CP27*A1&CP18<*A1&CP15<*A1*A2                                      16

      A8A#%%CP28*A1&CP19<*A1&CP16<*A1*A2                                      17

      A6#A6A&A6B                                                              18

      A7#A7A&A7B                                                              19

      A8#A8A&A8B                                                              20

      A9 # 2.*A6                                                              21

      A10# 3.*A7                                                              22

      A11# 4.*A8                                                              23

      B1#1./TS                                                                24

      B2#B1*B1                                                                25

      A13#0.0                                                                 26

      IF %IHE.EQ.1< A13#%A6A&A7A*B1&A8A*B2<*CP20*A1*B2*B2                     27

      TSF#%%%%G1*B2&A8<*B1&A7<*B1&A6<*B1&A5<*B1&%CP22*TS*A1*DS&A4<*TS&A3      28

      RETURN                                                                  29

      ENTRY DTSF%TS<                                                          30

C                                                                             31

C        DERIVATIVE OF FUNCTION USED TO SOLVE FOR TEMPERATURE TS              32

C        GIVEN PRESSURE AND DENSITY                                           33

C                                                                             34

      DTSF#A4&A12*TS-%%%%6.*G1*B1*B1&A11<*B1&A10<*B1&A9<*B1&A5<*B1*B1         35

     1&A13                                                                    36

      TSF#DTSF                                                                37

      RETURN                                                                  38

      END                                                                     39

$IBFTC TSSS1

      FUNCTION TSSF%TSS<                                                       1

C                                                                              2

C        FUNCTION USED TO SOLVE FOR SATURATION TEMPERATURE TSS                 3

C        GIVEN PRESSURE                                                        4

C                                                                              5

      COMMON/COSAT/ CPS1   ,CPS2,CPS3,CPS4,CPS5,CPS6,CPS7                      6

      COMMON/BEND9/A1,A2,A3,A4,A5                                              7

      TSSF#%%%%CPS7*TSS&CPS6<*TSS&CPS5<*TSS&CPS4<*TSS&CPS3<*TSS&CPS2/          8

     1TSS&A1                                                                   9

      RETURN                                                                  10

      ENTRY  DTSSF%TSS<                                                       11

C                                                                             12

C        DERIVATIVE OF FUNCTION USED TO SOLVE FOR SATURATION                  13

C        TEMPERATURE TSS GIVEN PRESSURE                                       14

C                                                                             15

      DTSSF#%%%A2*TSS&A3<*TSS&A4<*TSS&A5<*TSS&CPS3-CPS2/%TSS*TSS<             16

      TSSF#DTSSF                                                              17

      RETURN                                                                  18

      END                                                                     19

$IBFTC TSST

      FUNCTION TSS%PS<                                                         1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE SATURATION TEMPERATURE GIVEN PRESSURE PS                      4

C                                                                              5

      COMMON/CHECKS/DCH1%1<,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,H       6

     1SCH1,HSCH2                                                               7

      COMMON/COSAT/ CPS1   ,CPS2,CPS3,CPS4,CPS5,CPS6,CPS7                      8

      COMMON/BEND9/A1,A2,A3,A4,A5                                              9

      EXTERNAL TSSF,DTSSF                                                     10

      PS1#PS/.101325                                                          11

      A1#CPS1-ALOG10%PS1<                                                     12

      A2#5.*CPS7                                                              13

      A3#4.*CPS6                                                              14

      A4#3.*CPS5                                                              15

      A5#2.*CPS4                                                              16

      TESTM#PS/%PCH1-PCH2<*%TCH2-TCH1<&TCH1 -10.                              17

      IF %TESTM.LT.TCH1< TESTM#TCH1                                           18

      TSS#SOLVE%TESTM,TSSF,DTSSF<                                             19

      RETURN                                                                  20

      END                                                                     21

$IBFTC PSSS

      SUBROUTINE PSSS%PSS<                                                     1

C     ---------------------------VERSION 2/1/72-------------------------       2

C                                                                              3

C        COMPUTE SATURATION PRESSURE PSS GIVEN TEMPERATURE                     4

C                                                                              5

      COMMON/COSAT/ CPS1   ,CPS2,CPS3,CPS4,CPS5,CPS6,CPS7                      6

      COMMON/BEND17/TS                                                         7

      PSS#10.**%%%%%CPS7*TS&CPS6<*TS&CPS5<*TS&CPS4<*TS&CPS3<*TS&CPS2/TS&       8

     1CPS1<                                                                    9

      PSS#PSS*.101325                                                         10

      RETURN                                                                  11

      END                                                                     12

$IBFTC ENTH1

      SUBROUTINE ENTH%KU,KR,T,P,D,H,HL,HV<                                     1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE ENTHALPY H GIVEN TEMPERATURE T, PRESSURE P, AND               4

C        DENSITY D.  UNITS ARE SPECIFIED BY KU.  REGION IS                     5

C        SPECIFIED BY KR.  IF KR IS SPECIFIED AS 1, THE SATURATED              6

C        LIQUID AND VAPOR ENTHALPIES, HL AND HV RESPECTIVELY,                  7

C        ARE COMPUTED AS A FUNCTION OF T ONLY.                                 8

C                                                                              9

      COMMON/CONV6/HCONV%5<                                                   10

      COMMON /BEND17/TS                                                       11

      COMMON /BEND23/DSL,DSV                                                  12

      COMMON /BEND29/HSL,HSV                                                  13

      COMMON /IERROR/IROUT                                                    14

      IROUT#4                                                                 15

      TS#TCHECK%KU,KR,T<                                                      16

      PS#PCHECK%KU,KR,P<                                                      17

      IF %KR.NE.1< DS#DCHECK%KU,D<                                            18

      GO TO %10,20,30<,KR                                                     19

C                                                                             20

C        REGION 1                                                             21

C                                                                             22

   10 CALL HSLV%PS<                                                           23

      HL#HSL*HCONV%KU<                                                        24

      HV#HSV*HCONV%KU<                                                        25

      RETURN                                                                  26

C                                                                             27

C        REGION 2                                                             28

C                                                                             29

   20 CALL PSSS%PSS<                                                          30

      CALL HSLV%PSS<                                                          31

      HS # HSL& PS/DS-PSS/DSL&HDINT%DS,DSL<                                   32

      GO TO 40                                                                33

C                                                                             34

C        REGION 3                                                             35

C                                                                             36

   30 HS#HSS%PS,DS<                                                           37

   40 H#HS*HCONV%KU<                                                          38

      RETURN                                                                  39

      END                                                                     40

$IBFTC HSSLVF

      FUNCTION HSSLVF%PS<                                                      1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        FUNCTION USED TO COMPUTE SATURATED LIQUID ENTHALPY                    4

C        FROM SATURATED VAPOR ENTHALPY OR SATURATED LIQUID ENTROPY             5

C        FROM SATURATED VAPOR ENTROPY GIVEN PRESSUE PS AND                     6

C        TEMPERATURE                                                           7

C                                                                              8

      COMMON/COSAT/ CPS1   ,CPS2,CPS3,CPS4,CPS5,CPS6,CPS7                      9

      COMMON/BEND17/TS                                                        10

      COMMON/BEND23/DSL,DSV                                                   11

      DPDT#2.30258509*PS*%%%%5.*CPS7*TS&4.*CPS6<*TS&3.*CPS5<*TS&              12

     12.*CPS4<*TS&CPS3-CPS2/%TS*TS<<                                          13

      HSSLVF#DPDT*%1./DSV-1./DSL<                                             14

      RETURN                                                                  15

      END                                                                     16

$IBFTC ENT1

      SUBROUTINE ENT%KU,KR,T,P,D,S,SL,SV<                                      1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE ENTROPY S GIVEN TEMPERATURE T, PRESSURE P, AND                4

C        DENSITY D.  UNITS ARE SPECIFIED BY KU.  REGION IS                     5

C        SPECIFIED BY KR.  IF KR IS SPECIFIED AS 1, THE SATURATED              6

C        LIQUID AND VAPOR ENTROPIES, SL AND SV RESPECTIVELY,                   7

C        ARE COMPUTED AS A FUNCTION OF T ONLY.                                 8

C                                                                              9

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,             10

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                       11

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                              12

      COMMON/BEND21/SSL,SSV                                                   13

      COMMON/BEND23/DSL,DSV                                                   14

      COMMON/BEND17/TS                                                        15

      COMMON/CONV4/SCONV%5<                                                   16

      COMMON /IERROR/IROUT                                                    17

      IROUT#5                                                                 18

      TS#TCHECK%KU,KR,T<                                                      19

      PS#PCHECK%KU,KR,P<                                                      20

      IF %KR.NE.1< DS#DCHECK%KU,D<                                            21

      GO TO %10,20,30<,KR                                                     22

C                                                                             23

C        REGION 1                                                             24

C                                                                             25

   10 CALL SSLV%PS<                                                           26

      SL#SSL*SCONV%KU<                                                        27

      SV#SSV*SCONV%KU<                                                        28

      RETURN                                                                  29

C                                                                             30

C        REGION 2                                                             31

C                                                                             32

   20 CALL PSSS%PSS<                                                          33

      CALL SSLV%PSS<                                                          34

      SS # SSL & R*%ALOG%DSL<-ALOG%DS<< & SDINT%DS,DSL<                       35

      GO TO 40                                                                36

C                                                                             37

C        REGION 3                                                             38

C                                                                             39

   30 SS#SSS%PS,DS<                                                           40

   40 S#SS*SCONV%KU<                                                          41

      RETURN                                                                  42

      END                                                                     43

$IBFTC HDINT1

      FUNCTION HDINT%DS,DSL<                                                   1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE THE INTEGRAL IN THE ENTHALPY COMPUTATION FROM                 4

C        DENSITY DSL TO DENSITY DS                                             5

C                                                                              6

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              7

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        8

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               9

      COMMON/BEND17/TS                                                        10

      COMMON/BEND27/A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A66                  11

      COMMON/HELFLU/ IHE, IFL, IHY                                            12

      T2#1.0                                                                  13

      IF %IHE.EQ.1< T2#TS                                                     14

      A1# 1./TS                                                               15

      A2# A1*A1                                                               16

      A3#-A2*T2/%2.*CP20<                                                     17

      A4#%%%%7.*CP25*A2&5.*CP21<*A1&4.*CP5<*A1&3.*CP4<*A1&2.*CP3<*A1&CP2      18

      A5#%-CP22/A2&CP7&2.*CP8*A1&3.*CP23*A2</2.                               19

      A6 # %%5.*CP16*A1& 4.*CP15< * A1 & 3.*CP14<                             20

      A66#%%5.*CP28*A1&4.*CP27<*A1&3.*CP26<                                   21

      A7 # %%5.*CP19*A1 & 4.*CP18<*A1 & 3.*CP17<                              22

      A8 # CP10/3.                                                            23

      A9# %CP12&2.*CP24*A1</4.                                                24

      A10 # CP13/5.                                                           25

      A11#T2/CP20                                                             26

      A12# %%CP16*A1&CP15<*A1&CP14<*A2                                        27

      A13# %%CP19*A1&CP18<*A1&CP17<*A2                                        28

      HDINT#HDINTF%DS<-HDINTF%DSL<                                            29

      RETURN                                                                  30

      ENTRY    SDINT%DS,DSL<                                                  31

C                                                                             32

C        COMPUTE THE INTEGRAL IN THE ENTROPY COMPUTATION FROM                 33

C        DENSITY DSL TO DENSITY DS                                            34

C                                                                             35

      T2#1.0                                                                  36

      IF %IHE.EQ.1< T2#TS                                                     37

      A1#1./TS                                                                38

      A2#A1*A1                                                                39

      A3#%%%%6.*CP25*A2&4.*CP21<*A1&3.*CP5<*A1&2.*CP4<*A1&CP3<*A2-CP1         40

      A4#%-2.*CP22*TS-CP6&%2.*CP23*A1&CP8<*A2</2.                             41

      A5 # %%4.*CP16*A1 & 3.*CP15<*A1 & 2.*CP14<                              42

      A6 # %%4.0*CP19*A1 & 3.0*CP18<*A1 & 2.0*CP17<                           43

      A66#%%4.0*CP28*A1&3.0*CP27<*A1&2.0*CP26<                                44

      A7 # -A2/%2.*CP20<*A1*T2                                                45

      A8 #-CP9/3.                                                             46

      A9#%-CP11&CP24*A2</4.                                                   47

      A10#T2/CP20                                                             48

      A12# %%CP16*A1&CP15<*A1&CP14<*A2                                        49

      A13# %%CP19*A1&CP18<*A1&CP17<*A2                                        50

      SDINT#SDINTF%DS<-SDINTF%DSL<                                            51

      HDINT#SDINT                                                             52

      RETURN                                                                  53

      END                                                                     54

$IBFTC HDINT2

      FUNCTION HDINTF%DS<                                                      1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        FUNCTION USED TO COMPUTE THE INTEGRAL IN THE ENTHALPY                 4

C        COMPUTATION BASED ON DENSITY DS                                       5

C                                                                              6

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              7

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        8

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               9

      COMMON/HELFLU/ IHE, IFL, IHY                                            10

      COMMON/BEND17/TS                                                        11

      COMMON/BEND27/A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A66                  12

      T2#1.0                                                                  13

      IF %IHE.EQ.1< T2#TS                                                     14

      B1#DS*DS                                                                15

      B2 # EXP%-CP20*B1/T2<                                                   16

      A15#0.0                                                                 17

      IF %IHE.EQ.1< A15#%A12*%B1&A11<&A13*%%B1&2.*A11<*B1&2.*A11*A11<<        18

     1*B2/2.                                                                  19

      HDINTF# %%%%A10*DS & A9 <*DS&A8<*DS&A5<*DS&A4<*DS&                      20

     1 A3*B2*%A6 &%B1&A11<*A7&A66*%B1*B1&2.*B1/CP20&2./%CP20*CP20<<<&A15      21

      RETURN                                                                  22

      ENTRY SDINTF%DS<                                                        23

C                                                                             24

C        FUNCTION USED TO COMPUTE THE INTEGRAL IN THE ENTROPY                 25

C        COMPUTATION BASED ON DENSITY DS                                      26

C                                                                             27

      T2#1.0                                                                  28

      IF %IHE.EQ.1< T2#TS                                                     29

      B1#DS*DS                                                                30

      B2# EXP%-CP20*B1/T2<                                                    31

      A15#0.0                                                                 32

      IF %IHE.EQ.1< A15#A12*B2*%B1/T2&1./CP20</2.&A13*B2*%B1*B1/%2.*T2<       33

     1&B1/CP20&A10/CP20<                                                      34

      SDINTF# %%%A9*DS&A8<*DS & A4<*DS&A3<*DS&B2*A7*%A5&A6*%B1&A10<&A66*      35

     1%B1*B1&2.*B1/CP20&2./%CP20*CP20<<<&A15                                  36

      HDINTF#SDINTF                                                           37

      RETURN                                                                  38

      END                                                                     39

$IBFTC STEMPS

      SUBROUTINE TEMPPS %KU,P,S,T,D,DL,DV,KR <                                 1

C     ---------------------------VERSION 2/1/72-------------------------       2

      COMMON/ CON123/ DCONV%5<,TCONV%5<,PCONV%5<                               3

      COMMON/CONV4/ SCONV%5<                                                   4

      COMMON/BEND31/PS                                                         5

      COMMON /BEND55/SS                                                        6

      COMMON/CHECKS/DCH1,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,           7

     1HSCH1,HSCH2                                                              8

      COMMON /IERROR/IROUT                                                     9

      IROUT#7                                                                 10

      EXTERNAL TPSF                                                           11

      PS#PCHECK%KU,KR,P<                                                      12

      SS # S/SCONV%KU<                                                        13

   40 IF %PS-PCH2< 140,140,130                                                14

  130 TS1#TCH1                                                                15

      TS2#TCH3                                                                16

      GO TO 110                                                               17

  140 CALL TEMP%1,PS,ZE,TS,1<                                                 18

      IF %KR-1< 50,70,50                                                      19

   50 CALL ENT % 1,1,TS,PS,ZE ,ZE ,SSL,SSV <                                  20

      IF % SS-SSL <  90,70,60                                                 21

   60 IF % SS-SSV< 70,70,100                                                  22

C                                                                             23

C        REGION 1                                                             24

C                                                                             25

   70 KR#1                                                                    26

   80 CALL DENS%1,TS,ZE,ZE,DSL,DSV,1<                                         27

      DL#DSL*DCONV%KU<                                                        28

      DV#DSV*DCONV%KU<                                                        29

      GO TO 120                                                               30

C                                                                             31

C        REGION 2                                                             32

C                                                                             33

   90 KR#2                                                                    34

      TS1#TCH1                                                                35

      PS#PS*1.00011                                                           36

      TS2# TS-1.E-5                                                           37

      GO TO 110                                                               38

C                                                                             39

C        REGION 3                                                             40

C                                                                             41

  100 KR#3                                                                    42

      TS1# TS&1.E-5                                                           43

      PS# PS*.99988                                                           44

      TS2#TCH3                                                                45

C                                                                             46

C        REGIONS 2 AND 3                                                      47

C                                                                             48

  110 CALL ROOTX % TS1,TS2,SS,TPSF,TS <                                       49

      CALL DENS%1,TS,PS,DS,ZE,ZE,KR<                                          50

      D#DS*DCONV%KU<                                                          51

C                                                                             52

C        VERIFY REGION                                                        53

C                                                                             54

      IF %PS-PCH2< 120,120,150                                                55

  150 IF %TS-TCH2< 160,160,170                                                56

  160 KR#2                                                                    57

      GO TO 120                                                               58

  170 KR#3                                                                    59

  120 T#TS*TCONV%KU<                                                          60

      RETURN                                                                  61

      END                                                                     62

$IBFTC TSHF1

      FUNCTION TSHF%TS<                                                        1

C     ---------------------------VERSION 2/1/72-------------------------       2

      COMMON/BEND31/PS                                                         3

      COMMON/BEND33/HS                                                         4

      KR#0                                                                     5

      CALL DENS%1,TS,PS,DS,ZE,ZE,KR<                                           6

      CALL ENTH%1,KR,TS,PS,DS,HSC,ZE,ZE<                                       7

      TSHF#HSC                                                                 8

      RETURN                                                                   9

      ENTRY TPSF%TS<                                                          10

      COMMON /BEND55/ SS                                                      11

      KR # 0                                                                  12

      CALL DENS % 1,TS,PS,DS,ZE,ZE,KR<                                        13

      CALL ENT % 1,KR,TS,PS,DS,SSC,ZE,ZE<                                     14

      TSHF # SSC                                                              15

      RETURN                                                                  16

      END                                                                     17

$IBFTC HSLV1

      SUBROUTINE HSLV%PS<                                                      1

C                                                                              2

C        COMPUTE SATURATED LIQUID AND VAPOR ENTHALPIES GIVEN                   3

C        PRESSURE PS AND TEMPERATURE                                           4

C                                                                              5

C     ---------------------------VERSION 2/1/72-------------------------       6

      COMMON/BEND17/TS                                                         7

      COMMON/BEND23/DSL,DSV                                                    8

      COMMON/BEND29/HSL,HSV                                                    9

      CALL DENS%1,TS,ZE,ZE,DSL,DSV,1<                                         10

      HSV#HSS%PS,DSV<                                                         11

      HSL#HSV-TS*HSSLVF%PS<                                                   12

      RETURN                                                                  13

      ENTRY SSLV%PS<                                                          14

C                                                                             15

C     ------------------VERSION  2/23/71--------------------------------      16

C        COMPUTE SATURATED LIQUID AND VAPOR ENTROPIES GIVEN                   17

C        PRESSURE PS AND TEMPERATURE                                          18

C                                                                             19

      COMMON/BEND21/SSL,SSV                                                   20

      CALL DENS%1,TS,ZE,ZE,DSL,DSV,1<                                         21

      SSV#SSS%PS,DSV<                                                         22

      SSL#SSV-HSSLVF%PS<                                                      23

      RETURN                                                                  24

      END                                                                     25

$IBFTC TEMPP1

      SUBROUTINE TEMPPH%KU,P,H,T,D,DL,DV,KR<                                   1

C     ---------------------------VERSION 2/1/72-------------------------       2

      COMMON/CON123/DCONV%5<,TCONV%5<,PCONV%5<                                 3

      COMMON/CONV6/HCONV%5<                                                    4

      COMMON/BEND31/PS                                                         5

      COMMON/BEND33/HS                                                         6

      COMMON/CHECKS/DCH1,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,           7

     1HSCH1,HSCH2                                                              8

      COMMON /IERROR/IROUT                                                     9

      IROUT#6                                                                 10

      EXTERNAL TSHF                                                           11

      PS#PCHECK%KU,KR,P<                                                      12

      HS#H/HCONV%KU<                                                          13

      IF %HS-HSCH1< 20,10,10                                                  14

   10 IF %HS-HSCH2< 40,40,20                                                  15

   20 WRITE%6,21< HS                                                          16

   21 FORMAT%1H0,E14.6,40H INPUT H IS OUT OF RANGE--CALC.CONT.        <       17

   40 IF %PS-PCH2< 140,140,130                                                18

  130 TS1#TCH1                                                                19

      TS2#TCH3                                                                20

      GO TO 110                                                               21

  140 CALL TEMP%1,PS,ZE,TS,1<                                                 22

      IF %KR-1< 50,70,50                                                      23

   50 CALL ENTH%1,1,TS,PS,ZE,ZE,HSL,HSV<                                      24

      IF %HS-HSL< 90,70,60                                                    25

   60 IF %HS-HSV< 70,70,100                                                   26

C                                                                             27

C        REGION 1                                                             28

C                                                                             29

   70 KR#1                                                                    30

   80 CALL DENS%1,TS,ZE,ZE,DSL,DSV,1<                                         31

      DL#DSL*DCONV%KU<                                                        32

      DV#DSV*DCONV%KU<                                                        33

      GO TO 120                                                               34

C                                                                             35

C        REGION 2                                                             36

C                                                                             37

   90 KR#2                                                                    38

      TS1#TCH1                                                                39

      PS#PS*1.00011                                                           40

      TS2# TS-1.E-5                                                           41

      GO TO 110                                                               42

C                                                                             43

C        REGION 3                                                             44

C                                                                             45

  100 KR#3                                                                    46

      TS1# TS&1.E-5                                                           47

      PS# PS*.99988                                                           48

      TS2#TCH3                                                                49

C                                                                             50

C        REGIONS 2 AND 3                                                      51

C                                                                             52

  110 CALL ROOTX%TS1,TS2,HS,TSHF,TS<                                          53

      CALL DENS%1,TS,PS,DS,ZE,ZE,KR<                                          54

      D#DS*DCONV%KU<                                                          55

C                                                                             56

C        VERIFY REGION                                                        57

C                                                                             58

      IF %PS-PCH2< 120,120,150                                                59

  150 IF %TS-TCH2< 160,160,170                                                60

  160 KR#2                                                                    61

      GO TO 120                                                               62

  170 KR#3                                                                    63

  120 T#TS*TCONV%KU<                                                          64

      RETURN                                                                  65

      END                                                                     66

$IBFTC SPCHTV

      SUBROUTINE SPCHV%KU,KR,KCP,T ,P ,D ,CV<                                  1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C                                                                              4

C        COMPUTE SPECIFIC HEAT CV GIVEN TEMPERATURE T, PRESSURE P,             5

C        AN DENSITY D.  UNITS ARE SPECIFIED BY KU.  REGION IS                  6

C        SPECIFIED BY KR.  IF KR IS SPECIFIED AS 1, THE SATURATED              7

C        LIQUID AND VAPOR SPECIFIC HEATS, CVL AND CVV RESPECTIVELY,            8

C        ARE COMPUTED.                                                         9

C                                                                             10

      DIMENSION CVS%5<                                                        11

      COMMON /CONV4/ SCONV%5<                                                 12

      COMMON/BEND38/ TSH%6<,TS                                                13

      COMMON/BEND39/DS                                                        14

      COMMON/CHECKS/DCH1%1<,DCH2,PCH1,PCH2,PCH3,TCH1,TCH2,TCH3,DST,TST,H      15

     1SCH1,HSCH2                                                              16

      COMMON/SWITS/KSWIT,TSWIT,DIFT,RSWIT                                     17

      COMMON /IERROR/IROUT                                                    18

      IROUT#10                                                                19

      TS#T                                                                    20

      PS#P                                                                    21

      DS#D                                                                    22

      IF %KR-1< 100,10,100                                                    23

C                                                                             24

C        REGIONS 2 AND 3                                                      25

C                                                                             26

  100 IF%PS-PCH2< 40,40,150                                                   27

  150 TSS # TCH2                                                              28

      GO TO 160                                                               29

   40 CALL TEMP%1,PS,ZE,TSS,1<                                                30

  160 GO TO %10,20,30<,KR                                                     31

C                                                                             32

C        REGION 1                                                             33

   10 GO TO %12,14<,KCP                                                       34

   12 TSH%1<#TS                                                               35

      CALL CVPS%1,2,CVS<                                                      36

      CV#CVS%1<                                                               37

      RETURN                                                                  38

   14 TSH%1<#TS                                                               39

C                                                                             40

      CALL CVPS%1,3,CVS<                                                      41

      CV#CVS%1 <                                                              42

      RETURN                                                                  43

C                                                                             44

C        REGION 2                                                             45

C                                                                             46

   20 TSH%1<#TS                                                               47

      IF %TSS.LE.TS-DIFT< TSH%1<#TS-DIFT                                      48

      IF %TSS.LE.TS-2.*DIFT< TSH%1<#TS-2.*DIFT                                49

      GO TO 90                                                                50

C                                                                             51

C        REGION 3                                                             52

C                                                                             53

   30 TSH%1<#TS-2.*DIFT                                                       54

      IF %TSS.GE.TS-2.*DIFT< TSH%1<#TS-DIFT                                   55

      IF %TSS.GE.TS-DIFT< TSH%1<#TS                                           56

   90 CONTINUE                                                                57

      CALL CVPS%1,KR,CVS<                                                     58

      CV#CVS%1<                                                               59

      RETURN                                                                  60

      END                                                                     61

$IBFTC CVPSS

      SUBROUTINE CVPS%KVP,KR,CVS<                                              1

C                                                                              2

C                                                                              3

C     ---------------------------VERSION 2/1/72-------------------------       4

C        ROUTINE USED TO COMPUTE SPECIFIC HEAT CVS GIVEN                       5

C        TEMPERATURE, PRESSURE, AND DENSITY.  WHETHER DENSITY OR               6

C        PRESSURE IS CONSTANT IS SPECIFIED BY KVP.  REGION IS                  7

C        SPECIFIED BY KR.                                                      8

C                                                                              9

      DIMENSION HS%5<,CVS%5<                                                  10

      COMMON/SWITS/KSWIT,TSWIT,DIFT,RSWIT                                     11

      COMMON/BEND37/PS                                                        12

      COMMON/BEND38/ TSH%6<,TS                                                13

      COMMON/BEND39/DS                                                        14

      IF %KVP-1< 60,70,60                                                     15

   70 ASSIGN 80 TO JUMP                                                       16

      GO TO 90                                                                17

   60 ASSIGN 100 TO JUMP                                                      18

   90 DO 50 I#1,5                                                             19

      GO TO JUMP,%80,100<                                                     20

   80 CALL PRESS%1,TSH%I<,DS,PSH,KRH<                                         21

      CALL ENTH%1,KRH,TSH%I<,PSH,DS,HS%I<,HSL,HSV<                            22

      IF %KRH.EQ.1< GO TO 95                                                  23

      HS%I<#HS%I<-PSH/DS                                                      24

      UHS # HS%I<                                                             25

      GO TO 50                                                                26

   95 IF %KR.EQ.2< HS%I<#HSL-PSH/DS                                           27

      IF %KR.EQ.3< HS%I<#HSV-PSH/DS                                           28

      KRH#0                                                                   29

      GO TO 50                                                                30

  100 CALL DENS%1,TSH%I<,PS,DSH,DLS,DVS,KRH<                                  31

      CALL ENTH%1,KRH,TSH%I<,PS,DSH,HS%I<,HSL,HSV<                            32

  110 IF %KRH-1< 50,10,50                                                     33

   10 IF %KR-2< 30,20,30                                                      34

   20 HS%I<#HSL                                                               35

      GO TO 40                                                                36

   30 HS%I<#HSV                                                               37

   40 KRH#0                                                                   38

   50 TSH%I&1<#TSH%I<&DIFT                                                    39

      CALL SPLINA%TSH,HS,5,TS,1,CVS,1,KERROR<                                 40

      RETURN                                                                  41

      END                                                                     42

$IBFTC PTRHO1

      SUBROUTINE PTRHO%DS,TS<                                                  1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              4

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        5

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               6

      COMMON/BEND35/A2,A3,A4,A5,A6A,A6B,A7A,A7B,A8A,A8B,A11,A12,A13,A14,       7

     1A15,A16,A16A                                                             8

      COMMON/HELFLU/ IHE, IFL, IHY                                             9

      COMMON/PARTLS/PTV,PDT                                                   10

      T2#1.                                                                   11

      IF %IHE.EQ.1< T2#TS                                                     12

      ADDFL#A16A*A2*%7.-2.*CP20*DS*DS<                                        13

      PDT# %%%%%ADDFL   &6.*CP13-2.*CP20*A16*A2/T2<*DS&5.*A14<*DS&%5.*A1      14

     16-2.*CP20/T2*A15<*A2&4.*A13<*DS&3.*A12<*DS&%2.*A11&3.*A15*A2<<*DS&      15

     2R*TS                                                                    16

      A9#1./TS                                                                17

      A10#A9*A9                                                               18

      A6#A6A&A6B                                                              19

      A7#A7A&A7B                                                              20

      A8#A8A&A8B                                                              21

      A17#0.0                                                                 22

      IF %IHE.EQ.1< A17#%A6A&A7A*A9&A8A*A10<*CP20*DS*DS*%A10*A10<             23

      PTV#A4-A10*%%%%6.*CP25*A10*DS*DS&4.*A8<*A9&3.*A7<*A9&2.*A6<*A9&A5<      24

     1&A17                                                                    25

      RETURN                                                                  26

      END                                                                     27

$IBFTC SONIC1

      SUBROUTINE SONIC%KU,KR,T,D,GAMMA,C<                                      1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE SONIC VELOCITY C GIVEN TEMPERATURE T, DENSITY D,              4

C        AND SPECIFIC HEAT RATIO GAMMA.  UNITS ARE SPECIFIED BY KU.            5

C        REGION IS SPECIFIED BY KR.                                            6

C                                                                              7

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              8

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        9

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                              10

      COMMON/CONV5/CCONV%5<                                                   11

      COMMON/HELFLU/ IHE, IFL, IHY                                            12

      COMMON/PARTLS/PTV,PDT                                                   13

      COMMON /IERROR/IROUT                                                    14

      IROUT#8                                                                 15

      TS#TCHECK%KU,KR,T<                                                      16

      T2#1.0                                                                  17

      IF %IHE.EQ.1< T2#TS                                                     18

      DS#DCHECK%KU,D<                                                         19

C                                                                             20

C        REGIONS 1, 2, AND 3                                                  21

C                                                                             22

      GAMPR#GAMMA*10.*PDT                                                     23

      CS#0.                                                                   24

      IF %GAMPR.GT.0.<CS#1000.*SQRT%GAMPR<                                    25

      C#CS*CCONV%KU<                                                          26

      RETURN                                                                  27

      END                                                                     28

$IBFTC CPPRLF

      FUNCTION CPPRLF%DS<                                                      1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              4

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        5

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               6

      COMMON/BEND17/TS                                                         7

      COMMON/HELFLU/ IHE, IFL, IHY                                             8

C                                                                              9

C          INTEGRAL OF %%T /RHO**2<%D2P/DT2< AT CONSTANT RHO<                 10

C                                                                             11

      COMMON/BEND35/A2,A3,A4,A5,A6A,A6B,A7A,A7B,A8A,A8B,A11,A12,A13,A14,      12

     1A15,A16,A16A                                                            13

      T2#1.0                                                                  14

      IF %IHE.EQ.1< T2#TS                                                     15

      B2 # DS*DS                                                              16

      B1#-EXP%-CP20*B2/T2</%2.*CP20*TS/T2<                                    17

      A1 # 1./TS                                                              18

      D2#B2& T2/CP20                                                          19

      D3#B2*B2&2.*B2/CP20&2./%CP20*CP20<                                      20

      D4 # A1*A1                                                              21

      A17#%10.*CP16*A1&6.*CP15<*A1&3.*CP14                                    22

      A18#%10.*CP19*A1&6.*CP18<*A1&3.*CP17                                    23

      A18A#%10.*CP28*A1&6.*CP27<*A1&3.*CP26                                   24

      A19#T2/CP20                                                             25

      A20#A19*A19                                                             26

      A21#%10.*CP16*A1&8.*CP15<*A1&6.*CP14                                    27

      A22#%10.*CP19*A1&8.*CP18<*A1&6.*CP17                                    28

      D5#1./CP20&B2/T2&B2*B2/%2.*T2*A19<                                      29

      D52#D5/CP20                                                             30

      D7#%%B2/A19&3.<*B2&6.*A19<*B2&6.*A20                                    31

      B3# EXP%-CP20*B2/T2<                                                    32

      TERM#0                                                                  33

      IF %IHE.NE.1< GO TO 10                                                  34

      TERM#B3*%D2*A21/%2.*T2*T2*T2<-A15*D5&A22*D52/T2-A16*D7/%2.*T2<<         35

   10 CONTINUE                                                                36

      CPPRLF#2.*D4*%%%%%21.*CP25*D4&10.*CP21<*A1&6.*CP5<*A1&3.*CP4<*A1&C      37

     1P3<*DS&%2.*CP22*TS&CP8&3.*CP23*A1&CP24*B2/2.<*B2/2.&%A17&D2*A18&D3      38

     2*A18A<*B1<&TERM                                                         39

      RETURN                                                                  40

      END                                                                     41

$IBFTC HEK

C     ---------------------------VERSION 2/1/72-------------------------       1

      FUNCTION CONZ%TEMP<                                                      2

C     KZERO TABLE IN MW/CM-K, T IN KELVIN, DECK OF 18 SEPT 70                  3

C           COURTESY OF HANS RODER     NBS LAB  BOULDER COLORADO               4

      DIMENSION A%55<,T%55<                                                    5

      DATA A/0.0376,0.0496,0.0608,0.0720,0.0829,0.0932,0.1028,0.1200,          6

     1 0.1350,0.1486,0.1610,0.1725,0.1933,0.2121,0.2292,0.2448,0.2594,         7

     2 0.2983,0.3357,0.3709,0.4042,0.4360,0.4666,0.5259,0.5821,0.6359,         8

     3 0.6877,0.7381,0.7862,0.8333,0.8791,0.9241,0.9680,1.0113,1.054,          9

     4 1.096,1.136,1.176,1.216,1.255,1.293,1.331,1.369,1.406,1.443,           10

     5 1.479,1.516,1.551,                 1.912,2.208,2.4836,2.743,2.99,      11

     63.226,3.453/                                                            12

      DATA T/1.9,2.5,3.0,3.5,4.0,4.5,5.0,6.,7.,8.,9.,10.,12.,14.,16.,         13

     1 18.,20.,25.,30.,35.,40.,45.,50.,60.,70.,80.,90.,100.,110.,120.,        14

     2 130.,140.,150.,160.,170.,180.,190.,200.,210.,220.,230.,240.,250.,      15

     3 260.,270.,280.,290.,300.,400.,500.,600.,700.,800.,900.,1000./          16

      TT# TEMP                                                                17

    9 DO 11  J#1,58                                                           18

   10 IF%TT-T%J<<12,12,11                                                     19

   11 CONTINUE                                                                20

   12 CONTINUE                                                                21

   13 CONZ#A%J-1<&%TT-T%J-1<<*%A%J<-A%J-1<</%T%J<-T%J-1<<                     22

      RETURN                                                                  23

      END                                                                     24

$IBFTC CPPRL1

      SUBROUTINE CPPRL%P,D,T,CPPART,CVPART,KU,KR,KCP<                          1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              4

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        5

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               6

      COMMON/COCPO/TO   ,CCOP1,CCOP2,CCOP3,CCOP4,CCOP5                         7

      COMMON/BEND17/TT                                                         8

      COMMON/BEND35/A2,A3,A4,A5,A6A,A6B,A7A,A7B,A8A,A8B,A11,A12,A13,A14,       9

     1A15,A16,A16A                                                            10

      COMMON/HELFLU/ IHE, IFL, IHY                                            11

      COMMON/BEND36/CPO                                                       12

      COMMON/PARTLS/PTV,PDT                                                   13

      COMMON/REFNO/SOTO,HOTO,CPOCOR,HTERM,STERM                               14

      COMMON/SWITS/KSWIT,TSWIT,DIFT,RSWIT                                     15

      COMMON/CONV4/SCONV%5<                                                   16

      TS#TCHECK%KU,KR,T<                                                      17

      PS#PCHECK%KU,KR,P<                                                      18

      DS#DCHECK%KU,D<                                                         19

      IF %IHY.EQ.1< CALL SETCPO%TS<                                           20

        TT#TS                                                                 21

      IF %KR.EQ.1< KCP#KCP&1                                                  22

      ASSIGN 500 TO JUMP                                                      23

      IF %DS.GT.RSWIT< ASSIGN 600 TO JUMP                                     24

      IF %KSWIT.EQ.2.AND.%TS.LE.TSWIT.OR. DS.GT.RSWIT<<ASSIGN 600TOJUMP       25

      GO TO JUMP,%500,600<                                                    26

  500 A9 # 1./TS                                                              27

      A10 # A9*A9                                                             28

      A15 # %%CP16*A9 & CP15< * A9 & CP14< * A10                              29

      A16 # %%CP19*A9 & CP18<*A9 &CP17<*A10                                   30

C                                                                             31

C           TEST CP COMPUTED BY THE INTEGRAL OF THE SECOND                    32

C           PARTIAL OF P BY T                                                 33

C                                                                             34

      CPO # %%%CCOP5*TS&CCOP4< *TS&CCOP3<*TS&CCOP2<*TS&CCOP1                  35

      CVO# CPO*CPOCOR-R                                                       36

      CVPART#    -%CPPRLF%DS< - CPPRLF%0.<< & CVO                             37

      GO TO 1000                                                              38

  600 CALL SPCHV%KU,KR,KCP,TS,PS,DS,CVPART<                                   39

 1000 A1# DS*DS                                                               40

      T2#1.0                                                                  41

      IF %IHE.EQ.1< T2#TS                                                     42

      A2# DS*EXP%-CP20*DS*DS/T2<                                              43

      A3#%%%%CP13*DS&CP12<*DS&CP10<*DS&CP7<*DS&CP2<*A1                        44

      A4#%%%%CP11*DS&CP9<*DS&CP6<*DS&CP1<*DS&R< *DS                           45

      A4#A4&2.*CP22*A1*DS*TS                                                  46

      A5#%%CP24*A1&CP8<*DS&CP3<*A1                                            47

      A6A#%%CP26*A1&CP17<*A1&CP14<*A1*A2                                      48

      A6B# %CP23*DS&CP4<*A1                                                   49

      A7A#%%CP27*A1&CP18<*A1&CP15<*A1*A2                                      50

      A7B#CP5*A1                                                              51

      A8A#%%CP28*A1&CP19<*A1&CP16<*A1*A2                                      52

      A8B#CP21*A1                                                             53

      A9 # 1./TS                                                              54

      A10 # A9*A9                                                             55

      A11#%%%%CP25*A10&CP21<*A9&CP5<*A9&CP4<*A9&CP3<*A9&CP2&CP1*TS            56

      A12#%CP23*A9&CP8<*A9&CP7&%CP22*TS&CP6<*TS                               57

      A13 # CP10 & CP9 * TS                                                   58

      A14# CP11*TS&CP12 &CP24*A9                                              59

      A15 # %%CP16*A9 & CP15< * A9 & CP14< * A10                              60

      A16 # %%CP19*A9 & CP18<*A9 &CP17<*A10                                   61

      A16A#%%CP28*A9&CP27<*A9&CP26<*A10                                       62

      CALL PTRHO%DS,TS<                                                       63

      CPPART # CVPART& TS*PTV*PTV/%PDT*DS*DS<                                 64

      IF %KCP.EQ.2< KCP#0                                                     65

      CPPART#CPPART*SCONV%KU<                                                 66

      CVPART#CVPART*SCONV%KU<                                                 67

      RETURN                                                                  68

      END                                                                     69

$IBFTC SCPO

C     ---------------------------VERSION 2/1/72-------------------------       1

      SUBROUTINE  SETCPO%TIN<                                                  2

C         NEEDED FOR STEPWISE INTEGRATION                                      3

      DIMENSION ADDH%4<,ADDS%4<,HCPO%5,3<                                      4

      DATA ADDH/0.,-62.9775,-147.6,61.7/                                       5

      DATA ADDS/0.,-9.9313,5.361,-16.707/                                      6

      COMMON/COCPO/TO%1<,CCOP1,CCOP2,CCOP3,CCOP4,CCOP5                         7

      COMMON/HYDRO/DELH,DELS                                                   8

      DATA HCPO/                                                               9

     A14.7599360,-.21977388,.32100769E-2,-.12061502E-4,.57121808E-8,          10

     16.6557899 ,.15621077,-.86913643E-03,.18972274E-05,-.14418461E-08,       11

     214.4114861,-.71767870E-03,.18638538E-05,-.53065470E-09,.46649305E-      12

     313/                                                                     13

      TEST#TIN                                                                14

C                                                                             15

C        MULTIPLE FIT REQUIRES STEPWISE INTEGRATION FOR H2                    16

C                                                                             17

      IF %TEST.LT.40.< GO TO 40                                               18

   21 FORMAT%1H ,2E16.8<                                                      19

      K#1                                                                     20

      IF %TEST.LE.150.< GO TO 5                                               21

      K#2                                                                     22

      IF %TEST.LE.500.< GO TO 5                                               23

      K#3                                                                     24

    5 DO 10 I#2,6                                                             25

   10 TO%I< # HCPO%I-1,K<                                                     26

      GO TO 50                                                                27

   40 DO 41 I#3,6                                                             28

   41 TO%I<#0.0                                                               29

      TO%2<#4.968*4.184/2.01572                                               30

      RETURN                                                                  31

   50 DELH#ADDH%K&1<                                                          32

      DELS#ADDS%K&1<                                                          33

      RETURN                                                                  34

      END                                                                     35

$IBFTC HSS1

      FUNCTION HSS%PS,DS<                                                      1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE ENTHALPY IN REGION 3 OR SATURATED VAPOR ENTHALPY              4

C        GIVEN PRESSURE PS, DENSITY DS, AND TEMPERATURE                        5

C                                                                              6

      COMMON/BEND/ R   ,CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8,CP9,CP10,              7

     1CP11,CP12,CP13,CP14,CP15,CP16,CP17,CP18,CP19,CP20                        8

     2 ,CP21,CP22,CP23,CP24 ,CP25,CP26,CP27,CP28                               9

      COMMON/HELFLU/ IHE, IFL, IHY                                            10

      COMMON/COCPO/TO   ,CCOP1,CCOP2,CCOP3,CCOP4,CCOP5                        11

      COMMON/BEND17/TS                                                        12

      COMMON/BEND25/ A1,A2,A3,A4                                              13

      COMMON/HYDRO/DELH,DELS                                                  14

      COMMON/REFNO/SOTO,HOTO,CPOCOR,HTERM,STERM                               15

      HTINTF%TX<#%%%%A1*TX&A2<*TX&A3<*TX&A4<*TX&CCOP1<*TX                     16

      STINTF%TX<#%%%A1*TX&A2<*TX&A3<*TX&CCOP2<*TX&CCOP1*ALOG%TX<              17

      DELH#0.0                                                                18

      IF %IHY.EQ.1< CALL SETCPO%TS<                                           19

      A1#CCOP5/5.                                                             20

      A3#CCOP3/3.                                                             21

      A4#CCOP2/2.                                                             22

      A2#CCOP4/4.                                                             23

      HTERM1#HTINTF%TS<                                                       24

      HSS # HOTO & %HTERM1    &DELH-HTERM <*CPOCOR & PS/DS                    25

     1 -R*TS&HDINT%DS,0<                                                      26

      RETURN                                                                  27

      ENTRY  SSS%PS,DS<                                                       28

C                                                                             29

C        COMPUTE ENTROPY IN REGION 3 OR SATURATED VAPOR ENTROPY               30

C        GIVEN PRESSURE PS, DENSITY DS, AND TEMPERATURE                       31

C                                                                             32

C  THE TERM R*LN%RTD< IS NOT DIMENSIONLESS   CONSEQUENTLY  THE TERM           33

C  SHOULD BE       R*LN%RTD*CONV< # R*LN%CONV< & R*LN%RTD<                    34

C     THEREFORE ADD THE TERM  R*LN%CONV<                                      35

C          FOR   R  ATM-LITER/%GM-MOLE K<  DINNS  VALUE IMPLIES CONV#1        36

C          FOR   R  PSIA-CC/%GM  K<                   CONV# 14.696            37

C          FOR   R  J/%GM K<                          CONV# .101325           38

C    FOR  NITROGEN   THE CORRECTION BECOMES                                   39

C   BENDER   SCORR#R*ALOG%.101325<  #-.6794936                                40

      DELS#0.0                                                                41

      IF %IHY.EQ.1< CALL SETCPO%TS<                                           42

      A1#CCOP5/4.                                                             43

      A2#CCOP4/3.                                                             44

      A3#CCOP3/2.                                                             45

      STERM1#STINTF%TS<                                                       46

      SSS# SOTO & %STERM1 &   DELS-STERM   <*CPOCOR-R*ALOG%R*TS*DS<           47

     1 & SDINT%DS,0.<                                                         48

      HSS#SSS                                                                 49

      RETURN                                                                  50

      END                                                                     51

$IBFTC SURFAC

      SUBROUTINE SURF%KU,KR,T,SIGMA<                                           1

      DIMENSION STCONV%5<                                                      2

      DATA STCONV/2*1.,6.8521766E-5,2*1./                                      3

      COMMON/SURCON/PCTC,TCRIT,FIXIT,ZET                                       4

      COMMON/HELFLU/IHE,IFL,IHY                                                5

C                                                                              6

C     ---------------------------VERSION 2/1/72-------------------------       7

C      SURFACE TENSION  DYNE/CM                                                8

C                                                                              9

      COMMON /IERROR/IROUT                                                    10

      IROUT#13                                                                11

      SIGMA#0.                                                                12

      TS#TCHECK%KU,1,T<                                                       13

      IF % TS .GT. TCRIT< RETURN                                              14

      IF %IHY.EQ.1< GO TO 10                                                  15

      SIG#PCTC*%1.-TS/TCRIT<**%11./9.<*%.432/ZET-.951<*FIXIT                  16

      SIGMA#SIG  *STCONV%KU<                                                  17

      RETURN                                                                  18

   10 TR#TS/TCRIT                                                             19

      SIGMA#5.369*%1.0-TR<**1.065*STCONV%KU<                                  20

      RETURN                                                                  21

      END                                                                     22

$IBFTC VISC

      SUBROUTINE VISC%KU,KR,T,D,MU<                                            1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE VISCOSITY MU GIVEN TEMPERATURE T AND DENSITY D.               4

C        UNITS ARE SPECIFIED BY KU.  REGION IS SPECIFIED BY KR.                5

C                                                                              6

C      %U-U*<Z PARAMETER IS CALCULATED FROM JOSSI,STIEL,AND THODOS             7

C          VOL.8 NO.1   A.I.CH.E.JOURNAL  PAGE 60                              8

C                                                                              9

      DIMENSION COMEGA%15<,MCONV%5<                                           10

      REAL MUS,MCONV,MU,MUMZ                                                  11

      DATA %COMEGA%I<,I#1,15</2.,4.,-.52288,-1.33115022,.56160244,            12

     11.49894829,-1.84681526,1.58946684,.60206,.32481334E-1,                  13

     2-.23524079,.65223929,-1.03095995,1.40383078,2.60206/                    14

      COMMON/COFMU/EPSK,WM,DIS,RHOCRT,ZETA                                    15

      DATA MCONV/2*1.,.67196899E-1,2*1./                                      16

      COMMON/HELFLU/IHE,IFL,IHY                                               17

      COMMON /IERROR/IROUT                                                    18

      IROUT#12                                                                19

      TS#TCHECK%KU,KR,T<                                                      20

      DS#DCHECK%KU,D<                                                         21

      IF %IHY.EQ.1< GO TO 20                                                  22

C                                                                             23

C        REGIONS 1, 2, AND 3                                                  24

C                                                                             25

      XMS#.26693E-4*SQRT%WM*TS</%DIS*DIS*POLY%ALOG10%TS*EPSK<,COMEGA<<        26

      RHOR#DS/RHOCRT                                                          27

      MUMZ#%%RHOR*%RHOR*%RHOR*%RHOR*.0093324-.040758<&.058533<&.023364<       28

     1&.10230<**4-1.E-4</ZETA/10.**2                                          29

      DEBUG XMS,MUMS,DIS,RHOR,EPSK,DIST,ZETA                                  30

C                                                                             31

C             CORRECTION APPLIED TO FLUORINE DERIVED BY RCH FROM HANLEYS      32

C                                                                             33

      IF %IFL.EQ.1< MUMZ#MUMZ*%1.-.25*SIN%2.3808*ALOG%RHOR<<<                 34

      MUS#MUMZ&XMS                                                            35

      GO TO 30                                                                36

   20 XMS#8.5558*%TS**1.5/%TS&19.55<*%TS&650.39</%TS&1175.9<<*1.E-6           37

      AFUNC#EXP%5.7694&ALOG%DS<&65.*DS**1.5-6.E-6*EXP%127.2*DS<<              38

      DSTERM#DS/.07                                                           39

      RANGE#-58.75*%DS/.07<**3                                                40

      IF %RANGE.LT.-80.< RANGE#-80.                                           41

      BFUNC#10.0&7.2*%DSTERM**6-DSTERM**1.5<-17.63*EXP%RANGE<                 42

      MUS#XMS&AFUNC*EXP%BFUNC/TS<*1.E-6                                       43

   30 MU#MUS*MCONV%KU<                                                        44

      RETURN                                                                  45

      END                                                                     46

$IBFTC THER1

      SUBROUTINE THERM %KU,KR,P,T,D,EXCESK, K<                                 1

C                                                                              2

C     ---------------------------VERSION 2/1/72-------------------------       3

C        COMPUTE THERMAL CONDUCTIVITY K GIVEN TEMPERATURE T AND                4

C        DENSITY D.  UNITS ARE SPECIFIED BY KU.  REGION IS SPECIFIED           5

C        BY KR.                                                                6

C                                                                              7

      COMMON/HELFLU/ IHE, IFL, IHY                                             8

      COMMON/TCOND/CKMKST%9<, XLAMB,ZC5, RHOCR, TCR, TCSTAR, CKSTAR%18<        9

      COMMON/BEND/R,DUMY%28<                                                  10

      COMMON/COFMU/EPSK,WM,DIS,RHOCRT,ZETA                                    11

      COMMON/REFNO/SOTO,HOTO,CPOCOR,HTERM,STERM                               12

      COMMON/COCPO/TO,CCOP1,CCOP2,CCOP3,CCOP4,CCOP5                           13

      DIMENSION OMEGA1%9<,OMEGA2%15<                                          14

      REAL KMKS, KSRAT, K, KCONV ,KZERO                                       15

      DIMENSION KCONV%5<                                                      16

      DATA %OMEGA1%I<,I#1,9</1.,4.,-.5228,.82359030E-1,-.53982316,            17

     11.28552593,-1.53509952,1.44223760,2.602 /                               18

      DATA %OMEGA2%I<,I#1,15</2.,4.,-.52288,-1.33115022,.56160244,            19

     11.49894829,-1.84681526,1.58946684,.60206,.32481334E-1,                  20

     2-.23524079,.65223929,-1.03095995,1.40383078,2.60206/                    21

      DATA KCONV/2*1.,.01606044,2*1./                                         22

      COMMON /IERROR/IROUT                                                    23

      IROUT#11                                                                24

      TS#TCHECK%KU,KR,T<                                                      25

      DS#DCHECK%KU,D<                                                         26

C                                                                             27

C        REGIONS 1, 2, AND 3                                                  28

C                                                                             29

      IF %IHE.EQ.1< GO TO 30                                                  30

      IF %IHY.EQ.1< GO TO 38                                                  31

      RHO # DS/RHOCR                                                          32

      ARHO#ALOG10%RHO<                                                        33

      IF %ARHO.GT.CKMKST%3<< GO TO 10                                         34

      KMKS#10.**%ARHO-7.0<                                                    35

      GO TO 20                                                                36

   10 KMKS # 10.**%POLY%ALOG10%RHO<,CKMKST<< / %ZC5*XLAMB<                    37

   20 IF %IFL.EQ.1< GO TO 35                                                  38

      TR # TS/TCR                                                             39

      KSRAT # 10.** %POLY %ALOG10%TR<,CKSTAR<<*TCSTAR                         40

      K# %KMKS & KSRAT< * KCONV%KU< * 4.184                                   41

      GO TO 40                                                                42

   30 SLOPE#10.**%DS*%DS*%DS*%-621.369011<&224.2564<-29.48514<&2.0941961      43

     1<                                                                       44

      KMKS# ALOG10%TS</SLOPE*1.E-3                                            45

C       USE HANS RODERS  KO                                                   46

      KZERO#CONZ%TS< /1000.                                                   47

      K#%KMKS&KZERO<*KCONV%KU<                                                48

      GO TO 40                                                                49

C                                                                             50

C    FLUORINE KZERO CURVE BASED ON MASON-MONCHICK ANALYSIS                    51

C          FROM REID AND SHERWOOD PAGE 461 EQ 10-12                           52

C                                                                             53

   35 OM1#POLY%ALOG10%TS*EPSK<,OMEGA1<                                        54

      OM2#POLY%ALOG10%TS*EPSK<,OMEGA2<                                        55

      OM21#6.*OM2/OM1/5.                                                      56

      XMO#.26693E-4*SQRT%WM*TS</%DIS*DIS*OM2<                                 57

      CVO#CPOCOR*%%%%CCOP5*TS&CCOP4<*TS&CCOP3<*TS&CCOP2<*TS&CCOP1<            58

      KZERO#%1.77*R&OM21*CVO-2./3.14159*%2.5-OM21<**2*%CVO-1.5*R</            59

     1%2.&.02*TS**.83333<<*XMO                                                60

      K#%KMKS&KZERO<*KCONV%KU<                                                61

      GO TO 40                                                                62

C    USES RODERS HYDROGEN CALCULATION BUT NOT HIS CRITICAL SCALING FOR        63

C       REACTING CONDUCTIVITY NEAR THE CRITICAL REGION.                       64

C                                                                             65

   38 K#CONC%TS,DS</1.E3*KCONV%KU<                                            66

C                                                                             67

C          REACTING CONDUCTIVITY CALCULATED BY THE SENGERS-KEYES METHOD       68

C  GENERAL FLUID                                                              69

C                                                                             70

   40 DRHOC#ABS%DS-RHOCR</RHOCR                                               71

      DELAMB#0.0                                                              72

      IF %DRHOC.GT..6< GO TO 50                                               73

      DELTC#ABS%%TS-TCR</TCR<                                                 74

      RAT#DS/RHOCR                                                            75

      IF %DRHOC.LT..00001< GO TO 102                                          76

      IF %DELTC.LT.1.E-7< GO TO 101                                           77

      XBETA# DELTC**.35/DRHOC                                                 78

      IF%XBETA.GT..4<  GO TO 104                                              79

  101 DELAMB# 3.05E-5/%SQRT%RAT<*DRHOC**1.71<                                 80

      GO TO 50                                                                81

  104 IF%XBETA.GT.3.< GO TO 102                                               82

       DELAMB#3.05E-5/%SQRT%RAT<*DELTC**.6</%1.&.90/XBETA**%1./.35<<          83

     1**%3./5.<                                                               84

      GO TO 50                                                                85

  102 IF %DELTC.LT.1.E-7< GO TO 105                                           86

      DELAMB#3.05E-5/%SQRT%RAT<*DELTC**.6<                                    87

   50 EXCESK#DELAMB*KCONV%KU<                                                 88

      RETURN                                                                  89

  105 EXCESK#1.E30                                                            90

      RETURN                                                                  91

      END                                                                     92

$IBFTC HYDROK

      FUNCTION CONC%TMEAN,DEN<                                                 1

C                                                                              2

C    THIS ROUTINE BY HANS RODER HAS BEEN CHANGED TO COMMENT OUT THE            3

C     REACTING CONDUCTIVITY CALCULATIONS WHICH ARE NOT USED AT PRESENT         4

C                                                                              5

C     T KELVIN, DEN MUST BE IN GR/CC, CP IN CAL/MOLE                           6

C     THIS VERSION CHANGED TO INTERPOLATE LINEARLY IN K-0                      7

      DIMENSION AAA%12<,TTT%12<,D%3<                                           8

      DATA TTT            /13.000,17.020,19.587,25.100,30.010,33.063,          9

     1 40.145,59.187,79.845,99.852,122.909,153.0/                             10

      DATA AAA            /0.1765,0.3203,0.4121,0.6679,0.8491,0.9363,         11

     1 1.1153,1.4781,1.7895,2.0757,2.3357,2.5450/                             12

      DATA D           /9.88531118E-01,3.20886940E&01,-9.10140989E&02/        13

      CONC#0.                                                                 14

C       THIS CALCULATION BLOWS UP IF EXTRAPOLATED TOO FAR                     15

      IF %TMEAN.GT.248.< RETURN                                               16

    7 DO 9 J#1,12                                                             17

    8 IF%TMEAN  -TTT%J<<10,10,9                                               18

    9 CONTINUE                                                                19

   10 CONTINUE                                                                20

      CONZ1#0.1*EXP %AAA%J-1<<                                                21

      CONZJ#0.1*EXP %AAA%J<<                                                  22

   11 AAVE   #CONZ1   &%TMEAN-TTT%J-1<<*%CONZJ-CONZ1</%TTT%J<-TTT%J-1<<       23

      AAVE#ALOG%10.0*AAVE<                                                    24

C 203 CADJ   #TCADJ%TMEAN,DEN,CP<                                             25

      BB# 39.6-2.0*SQRT %248.0-%TMEAN  /10.0-17.<**2<                         26

   47 FUNC#AAVE   &D%  1<*BB             *DEN    &D%  2<*DEN    *DEN          27

     1 &D%  3</%TMEAN  -9.0<*DEN    *DEN                                      28

   48 CONC#0.1*EXP%FUNC<                                                      29

      RETURN                                                                  30

      END                                                                     31

